view src/EmacsShell-sub.c @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents 726060ee587c
children 308d34e9f07d
line wrap: on
line source

/* Emacs shell widget -- define the two widgets.
   Copyright (C) 1994, 1995 Sun Microsystems, Inc.

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. */

/* Written by Ben Wing, May, 1994. */

/*
   It is rather unfortunate that we have to do this.  Blame those
   short-sighted people who designed the monstrosities known as
   Xt and ICCCM.
*/

/*
   This widget is not actually Emacs-specific; perhaps there could
   be a better name than "EmacsShell".  What it does is work around
   a limitation in Xt in correctly dealing with the window-manager
   size hints with applications that

   (a) dynamically change their window size
   (b) have a cell size (width-inc and height-inc) other than 1

   and

   (c) cannot predict in advance exactly what size their shell will be
       (This is the more common situation, when you have a number
       of widgets, each with their own size ideas)

   This widget assumes that your program contains a fixed "base size"
   plus some number of cells (e.g. character cells).  The WMShell
   resources "widthInc" and "heightInc" specify the size of a
   character cell, and the window manager will report the app's
   size in cells rather than in pixels.

   If you use this widget, do not use the WMShell resources
   "baseWidth", "baseHeight", "minWidth", or "minHeight".
   Instead, use "widthCells" and "heightCells" to specify the
   current size in cells (you must keep this up-to-date),
   and "minWidthCells" and "minHeightCells" to specify the
   minimum size in cells.

   Every time that the program issues a size command, the
   "baseWidth", "baseHeight", "minWidth", and "minHeight" fields
   of the WM_NORMAL_HINTS property will be updated to stay in
   line with the resource values specified above.  The calculations
   are done once the desired shell size is known but before the
   window-manager size-change request is issued. (We must do it
   at this time because before then we don't know what size we
   will request, and after the request the deed has already
   been done.)

   After you change the "baseWidth", "baseHeight", "minWidth",
   or "minHeight" resources, you need to call
   EmacsShellUpdateSizeHints() to manually update the size
   hints, except in the following two circumstances:

   (a) you are about to make a geometry request.
   (b) you are changing only "baseWidth" and "baseHeight"
       from within a resize procedure.  (In this case,
       the size hints are already correct.)

*/

#include <config.h>

#include <stdio.h>
#include <stdlib.h>
#include <X11/StringDefs.h>
#include "xintrinsicp.h"
#include <X11/Shell.h>
#include <X11/ShellP.h>
#include <X11/Vendor.h>
#include <X11/VendorP.h>
#include "EmacsShellP.h"
#include "../lwlib/xt-wrappers.h"

#define ABORT abort

#if defined (DEFINE_TOP_LEVEL_EMACS_SHELL)
#define EMACS_SHELL_WIDGET TopLevelEmacsShellWidget
#define SUPERCLASS_WIDGET_CLASS topLevelShellWidgetClass
#define SUPERCLASS_CLASS_REC topLevelShellClassRec
#define EMACS_SHELL_REC TopLevelEmacsShellRec
#define EMACS_SHELL_CLASS_REC topLevelEmacsShellClassRec
#define EMACS_SHELL_CLASS_REC_TYPE TopLevelEmacsShellClassRec
#define EMACS_SHELL_CLASS_NAME "TopLevelEmacsShell"
#define EMACS_SHELL_WIDGET_CLASS topLevelEmacsShellWidgetClass
#define EMACS_SHELL_UPDATE_SIZE_HINTS TopLevelEmacsShellUpdateSizeHints
#elif defined (DEFINE_TRANSIENT_EMACS_SHELL)
#define EMACS_SHELL_WIDGET TransientEmacsShellWidget
#define SUPERCLASS_WIDGET_CLASS transientShellWidgetClass
#define SUPERCLASS_CLASS_REC transientShellClassRec
#define EMACS_SHELL_REC TransientEmacsShellRec
#define EMACS_SHELL_CLASS_REC transientEmacsShellClassRec
#define EMACS_SHELL_CLASS_REC_TYPE TransientEmacsShellClassRec
#define EMACS_SHELL_CLASS_NAME "TransientEmacsShell"
#define EMACS_SHELL_WIDGET_CLASS transientEmacsShellWidgetClass
#define EMACS_SHELL_UPDATE_SIZE_HINTS TransientEmacsShellUpdateSizeHints
#else
Error.  Must define either DEFINE_TOP_LEVEL_EMACS_SHELL or
DEFINE_TRANSIENT_EMACS_SHELL.
#endif

typedef struct {
    XtPointer           next_extension;
    XrmQuark            record_type;
    long                version;
    Cardinal            record_size;
} GenericClassExtRec;

static XtGeometryResult RootGeometryManager (Widget gw,
  XtWidgetGeometry *request, XtWidgetGeometry *reply);
static void ChangeManaged (Widget w);

/* snarfed from Shell.c */
#define BIGSIZE ((Dimension)32767)

static XtResource resources[] = {
#define offset(field) XtOffset(EMACS_SHELL_WIDGET, emacs_shell.field)
#define coreoffset(field) XtOffset(EMACS_SHELL_WIDGET, core.field)
#define res(name,_class,member,size)				\
  { (String) name, (String) _class, XtRInt, sizeof (int),	\
    offset (member), XtRImmediate, (XtPointer)0 }
#define motifres(name,member)					\
  { (String) name, XtCPosition, XtRPosition, sizeof (Position),	\
    coreoffset (member), XtRImmediate, (XtPointer)BIGSIZE }
#ifdef LWLIB_USES_MOTIF
  /* *** BOGOSITY^10! *** The Motif VendorShell fucks around with
     the default values for X and Y, for no obvious reason.  This
     causes Shell to indicate that the defaults of (0,0) were
     program-specified, instead of letting the WM do what it wants. */
  motifres (XtNx, x),
  motifres (XtNy, y),
#endif
  res (XtNwidthCells, XtCWidthCells, width_cells, 0),
  res (XtNheightCells, XtCHeightCells, height_cells, 0),
  res (XtNminWidthCells, XtCMinWidthCells, min_width_cells, 0),
  res (XtNminHeightCells, XtCMinHeightCells, min_height_cells, 0),
#undef offset
#undef coreoffset
#undef res
#undef motifres
};

static CompositeClassExtensionRec compositeClassExtRec = {
    NULL,
    NULLQUARK,
    XtCompositeExtensionVersion,
    sizeof (CompositeClassExtensionRec),
    TRUE,
};

static ShellClassExtensionRec shellClassExtRec = {
    NULL,
    NULLQUARK,
    XtShellExtensionVersion,
    sizeof (ShellClassExtensionRec),
    RootGeometryManager
};

EMACS_SHELL_CLASS_REC_TYPE EMACS_SHELL_CLASS_REC = {
    { /*
       *	core_class fields
       */
    /* superclass	  */	(WidgetClass) &SUPERCLASS_CLASS_REC,
    /* class_name	  */	(String) EMACS_SHELL_CLASS_NAME,
    /* size		  */	sizeof (EMACS_SHELL_REC),
    /* Class Initializer  */	NULL,
    /* class_part_initialize*/	NULL, /* XtInheritClassPartInitialize, */
    /* Class init'ed ?	  */	FALSE,
    /* initialize	  */	NULL,
    /* initialize_notify  */	NULL,
    /* realize		  */	XtInheritRealize,
    /* actions		  */	NULL,
    /* num_actions	  */	0,
    /* resources	  */	resources,
    /* resource_count	  */	XtNumber (resources),
    /* xrm_class	  */	NULLQUARK,
    /* compress_motion	  */	TRUE,
    /* compress_exposure  */	XtExposeCompressMaximal | XtExposeNoRegion,
    /* compress_enterleave*/	TRUE,
    /* visible_interest	  */	TRUE,
    /* destroy		  */	NULL,
    /* resize		  */	XtInheritResize,
    /* expose		  */	NULL,
    /* set_values	  */	NULL, /* XtInheritSetValues, */
    /* set_values_hook	  */	NULL,
    /* set_values_almost  */	XtInheritSetValuesAlmost,
    /* get_values_hook	  */	NULL,
    /* accept_focus	  */	NULL,
    /* intrinsics version */	XtVersion,
    /* callback offsets	  */	NULL,
    /* tm_table		  */	NULL,
    /* query_geometry	  */	NULL,
    /* display_accelerator*/	NULL,
    /* extension	  */	NULL
  },{ /* Composite */
    /* geometry_manager	  */	XtInheritGeometryManager,
    /* change_managed	  */	ChangeManaged,
    /* insert_child	  */	XtInheritInsertChild,
    /* delete_child	  */	XtInheritDeleteChild,
    /* extension	  */	(XtPointer)&compositeClassExtRec
  },{ /* Shell */
    /* extension	  */	(XtPointer)&shellClassExtRec
  },{ /* WMShell */
    /* extension	  */	NULL
  },{ /* VendorShell */
    /* extension	  */	NULL
  },{ /* TopLevelShell or TransientShell */
      /* both have exactly one XtPointer here. */
    /* extension	  */	NULL
  },{ /* EmacsShell */
    0
  }
};

WidgetClass EMACS_SHELL_WIDGET_CLASS = (WidgetClass) &EMACS_SHELL_CLASS_REC;

static void
update_size_hints_internal (EMACS_SHELL_WIDGET w,
			    int width, int height)
{
  int base_width, base_height;
  int cell_width, cell_height;
  Arg al [10];

  /* time to update them thar size hints */
  cell_width = w->wm.size_hints.width_inc;
  cell_height = w->wm.size_hints.height_inc;
  base_width = width - cell_width * w->emacs_shell.width_cells;
  base_height = height - cell_height * w->emacs_shell.height_cells;
#ifdef DEBUG_GEOMETRY_MANAGEMENT
  /* Very useful info when debugging geometry management problems.
     When it's guaranteed that no more such problems exist, take
     this stuff out. */
  printf ("update_size_hints_internal:\n");
  printf ("  actual pixel size: %d %d\n", width, height);
  printf ("  cell size in pixels: %d %d\n", cell_width, cell_height);
  printf ("  text area size in cells: %d %d\n", w->emacs_shell.width_cells,
	 w->emacs_shell.height_cells);
  printf ("  base size set to: %d %d\n", base_width, base_height);
  fflush (stdout);
#endif
  Xt_SET_ARG(al [0], XtNbaseWidth, base_width);
  Xt_SET_ARG(al [1], XtNbaseHeight, base_height);
  Xt_SET_ARG(al [2], XtNminWidth, base_width +
	     cell_width * w->emacs_shell.min_width_cells);
  Xt_SET_ARG(al [3], XtNminHeight, base_height +
	     cell_height * w->emacs_shell.min_height_cells);
  XtSetValues ((Widget) w, al, 4);
}

static XtGeometryResult
SuperClassRootGeometryManager (Widget gw,
			       XtWidgetGeometry *request,
			       XtWidgetGeometry *reply)
{
  ShellWidgetClass swc = (ShellWidgetClass) SUPERCLASS_WIDGET_CLASS;
  ShellClassExtensionRec *scer;
  GenericClassExtRec *gcer;

  /* find the shell extension record that specifies the
     root geometry manager method
     #### We could use XtGetClassExtension here. */
  for (gcer = (GenericClassExtRec *) swc->shell_class.extension;
       gcer;
       gcer = (GenericClassExtRec *) gcer->next_extension)
    {
      if (gcer->record_type == NULLQUARK)
	break;
    }

  /* #### The R11.6.4 Xt specification says if we don't find NULLQUARK here,
     we should assume root_geometry_manager = XtInheritRootGeometryManager.
     Is that actually callable? */
  if (!gcer)
    ABORT ();

  /* call it to actually make the geometry request */
  scer = (ShellClassExtensionRec *) gcer;
  return (scer->root_geometry_manager)(gw, request, reply);
}

static XtGeometryResult
RootGeometryManager (Widget gw,
		     XtWidgetGeometry *request,
		     XtWidgetGeometry *reply)
{
  EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) gw;
  /* OK since this file is not dumped */
  static int reentrant = 0;
  XtGeometryResult result;

  if (reentrant)
    ABORT ();
  reentrant++;

#ifdef DEBUG_GEOMETRY_MANAGEMENT
  printf ("root_geometry_manager:\n");
  printf ("  current shell size: %d %d\n", w->core.width, w->core.height);
  if (request->request_mode & CWWidth)
    printf ("width requested;");
  if (request->request_mode & CWHeight)
    printf ("height requested;");
  printf ("\n");
  printf ("  requested shell size: %d %d\n", request->width, request->height);
#endif
  /* update the size hints */
  update_size_hints_internal (w,
			      request->request_mode & CWWidth ?
			      request->width : w->core.width,
			      request->request_mode & CWHeight ?
			      request->height : w->core.height);

  result = SuperClassRootGeometryManager (gw, request, reply);

#ifdef DEBUG_GEOMETRY_MANAGEMENT
  printf ("  result: %s\n",
	  result == XtGeometryYes ? "XtGeometryYes" :
	  result == XtGeometryNo ? "XtGeometryNo" :
	  result == XtGeometryAlmost ? "XtGeometryAlmost" :
	  "XtGeometryDone");
  if (reply->request_mode & CWWidth)
    printf ("width returned was %d%s",
	    reply->width,
	    reply->request_mode & CWHeight ? "; " : ".\n");
  if (reply->request_mode & CWHeight)
    printf ("height returned was %d.\n", reply->height);
  /* #### does this also need to depend on the result?
     With XtGeometryYes there doesn't seem to be a useful reply object. */
  printf ("  resulting shell size: %d %d\n",
	  reply->request_mode & CWWidth ? reply->width : w->core.width,
	  reply->request_mode & CWHeight ? reply->height : w->core.height);
  printf ("----------\n");
  fflush (stdout);
#endif
  reentrant--;
  return result;
}

static void
ChangeManaged (Widget wid)
{
  EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) wid;

  /* If not realized, then we're being called from XtRealizeWidget().
     RootGeometryManager() has not yet been called, and thus our
     base size is incorrect.  We need to set it now or the Shell
     will mess up geometry specifications with negative positional
     offsets. */
  if (!XtIsRealized (wid))
    {
      Widget child = NULL;
      Cardinal i;

      /* the managed child indicates what our size is */
      for (i = 0; i < w->composite.num_children; i++) {
	if (XtIsManaged(w->composite.children[i])) {
	  child = w->composite.children[i];
	  break;
	}
      }

      update_size_hints_internal (w, child->core.width, child->core.height);
    }

  /* call the real ChangeManaged */
  (((ShellWidgetClass) SUPERCLASS_WIDGET_CLASS)->
   composite_class.change_managed)(wid);
}


/******************* external entry points *********************/

void
EMACS_SHELL_UPDATE_SIZE_HINTS (Widget gw)
{
  EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) gw;
  update_size_hints_internal (w, w->core.width, w->core.height);
}