Mercurial > hg > xemacs-beta
view lwlib/lwlib-Xlw.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 | 5460287a3327 |
children | ade4c7e2c6cb |
line wrap: on
line source
/* The lwlib interface to "xlwmenu" menus. Copyright (C) 1992, 1994 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #include <config.h> #include <stdlib.h> /* for abort () */ #include <stdio.h> /* for abort () */ #include <limits.h> #include "lwlib-Xlw.h" #include "lwlib-utils.h" #include <X11/StringDefs.h> #include <X11/IntrinsicP.h> #include <X11/ObjectP.h> #include <X11/CompositeP.h> #include <X11/Shell.h> #include <X11/Xmu/Converters.h> #ifdef HAVE_X_WIDGETS #include "../src/EmacsManager.h" #endif #ifdef LWLIB_MENUBARS_LUCID #include "xlwmenu.h" #endif #ifdef LWLIB_SCROLLBARS_LUCID #include "xlwscrollbar.h" #endif #ifdef LWLIB_TABS_LUCID #ifdef NEED_MOTIF #include "lwlib-Xm.h" #endif #ifdef NEED_ATHENA #include "lwlib-Xaw.h" #endif #include "xlwtabs.h" #endif #ifdef LWLIB_MENUBARS_LUCID /* Menu callbacks */ static void pre_hook (Widget w, XtPointer client_data, XtPointer call_data) { widget_instance* instance = (widget_instance*)client_data; widget_value* val; if (w->core.being_destroyed) return; val = lw_get_widget_value_for_widget (instance, w); #if 0 /* #### - this code used to (for some random back_asswards reason) pass the expression below in the call_data slot. For incremental menu construction, this needs to go. I can't even figure out why it was done this way in the first place...it's just a historical weirdism. --Stig */ call_data = (val ? val->call_data : NULL); #endif if (val && val->call_data) abort(); /* #### - the call_data for the top_level "menubar" widget_value used to be passed back to the pre_hook. */ if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (w, instance->info->id, call_data); } static void pick_hook (Widget w, XtPointer client_data, XtPointer call_data) { widget_instance* instance = (widget_instance*)client_data; widget_value* contents_val = (widget_value*)call_data; widget_value* widget_val; XtPointer widget_arg; LWLIB_ID id; lw_callback post_activate_cb; if (w->core.being_destroyed) return; /* Grab these values before running any functions, in case running the selection_cb causes the widget to be destroyed. */ id = instance->info->id; post_activate_cb = instance->info->post_activate_cb; widget_val = lw_get_widget_value_for_widget (instance, w); widget_arg = widget_val ? widget_val->call_data : NULL; if (instance->info->selection_cb && contents_val && contents_val->enabled && !contents_val->contents) instance->info->selection_cb (w, id, contents_val->call_data); if (post_activate_cb) post_activate_cb (w, id, widget_arg); } /* creation functions */ static Widget xlw_create_menubar (widget_instance* instance) { Arg al [1]; Widget widget; Xt_SET_ARG (al [0], XtNmenu, instance->info->val); widget = XtCreateWidget (instance->info->name, xlwMenuWidgetClass, instance->parent, al, 1); XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return widget; } static Widget xlw_create_popup_menu (widget_instance* instance) { Arg al [2]; Widget popup_shell, widget; popup_shell = XtCreatePopupShell (instance->info->name, overrideShellWidgetClass, instance->parent, NULL, 0); Xt_SET_ARG (al [0], XtNmenu, instance->info->val); Xt_SET_ARG (al [1], XtNhorizontal, False); widget = XtCreateManagedWidget ("popup", xlwMenuWidgetClass, popup_shell, al, 2); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return popup_shell; } #endif /* LWLIB_MENUBARS_LUCID */ #ifdef LWLIB_SCROLLBARS_LUCID static void xlw_scrollbar_callback (Widget widget, XtPointer closure, XtPointer call_data) { widget_instance *instance = (widget_instance *) closure; LWLIB_ID id; XlwScrollBarCallbackStruct *data = (XlwScrollBarCallbackStruct *) call_data; scroll_event event_data; scrollbar_values *val; double percent; if (!instance || widget->core.being_destroyed) return; val = (scrollbar_values *) instance->info->val->scrollbar_data; id = instance->info->id; percent = (double) (data->value - 1) / (double) (INT_MAX - 1); event_data.slider_value = (int) (percent * (double) (val->maximum - val->minimum)) + val->minimum; if (event_data.slider_value > val->maximum - val->slider_size) event_data.slider_value = val->maximum - val->slider_size; else if (event_data.slider_value < val->minimum) event_data.slider_value = val->minimum; if (data->event) { switch (data->event->type) { case KeyPress: case KeyRelease: event_data.time = data->event->xkey.time; break; case ButtonPress: case ButtonRelease: event_data.time = data->event->xbutton.time; break; case MotionNotify: event_data.time = data->event->xmotion.time; break; case EnterNotify: case LeaveNotify: event_data.time = data->event->xcrossing.time; break; default: event_data.time = 0; break; } } else event_data.time = 0; switch (data->reason) { case XmCR_DECREMENT: event_data.action = SCROLLBAR_LINE_UP; break; case XmCR_INCREMENT: event_data.action = SCROLLBAR_LINE_DOWN; break; case XmCR_PAGE_DECREMENT: event_data.action = SCROLLBAR_PAGE_UP; break; case XmCR_PAGE_INCREMENT: event_data.action = SCROLLBAR_PAGE_DOWN; break; case XmCR_TO_TOP: event_data.action = SCROLLBAR_TOP; break; case XmCR_TO_BOTTOM: event_data.action = SCROLLBAR_BOTTOM; break; case XmCR_DRAG: event_data.action = SCROLLBAR_DRAG; break; case XmCR_VALUE_CHANGED: event_data.action = SCROLLBAR_CHANGE; break; default: event_data.action = SCROLLBAR_CHANGE; break; } if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); } #define add_scrollbar_callback(resource) \ XtAddCallback (scrollbar, resource, xlw_scrollbar_callback, (XtPointer) instance) /* #### Does not yet support horizontal scrollbars. */ static Widget xlw_create_scrollbar (widget_instance *instance, int vertical) { Arg al[20]; int ac = 0; static XtCallbackRec callbacks[2] = { {xlw_scrollbar_callback, NULL}, {NULL, NULL} }; callbacks[0].closure = (XtPointer) instance; Xt_SET_ARG (al[ac], XmNminimum, 1); ac++; Xt_SET_ARG (al[ac], XmNmaximum, INT_MAX); ac++; Xt_SET_ARG (al[ac], XmNincrement, 1); ac++; Xt_SET_ARG (al[ac], XmNpageIncrement, 1); ac++; Xt_SET_ARG (al[ac], XmNorientation, (vertical ? XmVERTICAL : XmHORIZONTAL)); ac++; Xt_SET_ARG (al[ac], XmNdecrementCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNdragCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNincrementCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNpageDecrementCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNpageIncrementCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNtoBottomCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNtoTopCallback, callbacks); ac++; Xt_SET_ARG (al[ac], XmNvalueChangedCallback, callbacks); ac++; return XtCreateWidget (instance->info->name, xlwScrollBarWidgetClass, instance->parent, al, ac); } static Widget xlw_create_vertical_scrollbar (widget_instance *instance) { return xlw_create_scrollbar (instance, 1); } static Widget xlw_create_horizontal_scrollbar (widget_instance *instance) { return xlw_create_scrollbar (instance, 0); } static void xlw_update_scrollbar (widget_instance *UNUSED (instance), Widget widget, widget_value *val) { if (val->scrollbar_data) { scrollbar_values *data = val->scrollbar_data; int widget_sliderSize, widget_val; int new_sliderSize, new_value; double percent; Arg al [4]; /* First size and position the scrollbar widget. */ Xt_SET_ARG (al [0], XtNx, data->scrollbar_x); Xt_SET_ARG (al [1], XtNy, data->scrollbar_y); Xt_SET_ARG (al [2], XtNwidth, data->scrollbar_width); Xt_SET_ARG (al [3], XtNheight, data->scrollbar_height); XtSetValues (widget, al, 4); /* Now size the scrollbar's slider. */ Xt_SET_ARG (al [0], XmNsliderSize, &widget_sliderSize); Xt_SET_ARG (al [1], XmNvalue, &widget_val); XtGetValues (widget, al, 2); percent = (double) data->slider_size / (double) (data->maximum - data->minimum); percent = (percent > 1.0 ? 1.0 : percent); new_sliderSize = (int) ((double) (INT_MAX - 1) * percent); percent = (double) (data->slider_position - data->minimum) / (double) (data->maximum - data->minimum); percent = (percent > 1.0 ? 1.0 : percent); new_value = (int) ((double) (INT_MAX - 1) * percent); if (new_sliderSize > INT_MAX - 1) new_sliderSize = INT_MAX - 1; else if (new_sliderSize < 1) new_sliderSize = 1; if (new_value > (INT_MAX - new_sliderSize)) new_value = INT_MAX - new_sliderSize; else if (new_value < 1) new_value = 1; if (new_sliderSize != widget_sliderSize || new_value != widget_val) XlwScrollBarSetValues (widget, new_value, new_sliderSize, 1, 1, False); } } #endif /* LWLIB_SCROLLBARS_LUCID */ #ifdef LWLIB_TABS_LUCID /* tab control [[ lwlib is such an incredible hairy crock. I just cannot believe it! There are random dependencies between functions, there is a total lack of genericity, even though it initially appears to be generic. It should all be junked and begun again. Building tabs are an example - in theory we should be able to reuse a lot of the general stuff because we want to put labels of whatever toolkit we are using in the tab. Instead we have to hack it by hand. ]] While lwlib is a hairy crock, whoever wrote that seems to misunderstand Falk's tab control widget. The tab control widget has *two* kinds of children: *widgets*, which all occupy a *single* pane below the row of tabs---this is where the labels created in build_tabs_in_widget go, and *gadgets*, the tabs themselves, which do *not* draw themselves, but rather are drawn by the control. In fact, in XEmacs the true widget children are *never* visible! So this case is not a problem in the design of lwlib, but rather of Falk's widget. -- sjt */ static void xlw_tab_control_callback (Widget w, XtPointer client_data, XtPointer call_data) { /* call data is the topmost widget */ widget_instance* instance = (widget_instance*)client_data; Widget top = (Widget)call_data; char *name = XtName (top); widget_value* widget_val; XtPointer widget_arg; LWLIB_ID id; lw_callback post_activate_cb; if (w->core.being_destroyed) return; /* Grab these values before running any functions, in case running the selection_cb causes the widget to be destroyed. */ id = instance->info->id; post_activate_cb = instance->info->post_activate_cb; /* search for the widget_val for the selected tab */ for (widget_val = instance->info->val->contents; widget_val; widget_val = widget_val->next) { if (!strcmp (widget_val->name, name)) break; } widget_arg = widget_val ? widget_val->call_data : NULL; if (instance->info->selection_cb && widget_val && widget_val->enabled && !widget_val->contents) instance->info->selection_cb (w, id, widget_arg); if (post_activate_cb) post_activate_cb (w, id, widget_arg); } static Widget xlw_create_tab_control (widget_instance *instance) { Arg al[20]; int ac = 0; Widget tab = 0; widget_value* val = instance->info->val; Xt_SET_ARG (al [ac], XtNsensitive, val->enabled); ac++; Xt_SET_ARG (al [ac], XtNmappedWhenManaged, False); ac++; Xt_SET_ARG (al [ac], XtNorientation, XtorientHorizontal); ac++; /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); tab = XtCreateManagedWidget (val->name, tabsWidgetClass, instance->parent, al, ac); XtRemoveAllCallbacks (tab, XtNcallback); XtAddCallback (tab, XtNcallback, xlw_tab_control_callback, (XtPointer)instance); XtManageChild (tab); return tab; } static void build_tabs_in_widget (widget_instance* UNUSED (instance), Widget widget, widget_value* val) { widget_value* cur = val; Arg al[1]; /* Children are always invisible, don't permit resizing. */ Xt_SET_ARG (al[0], XtNresizable, False); for (cur = val; cur; cur = cur->next) { if (cur->value) { Widget w; #ifdef LWLIB_WIDGETS_MOTIF w = xm_create_label (widget, cur); #else w = xaw_create_label (widget, cur); #endif XtSetValues (w, al, 1); } cur->change = NO_CHANGE; } } static void xlw_update_tab_control (widget_instance* instance, Widget widget, widget_value* val) { Widget* children; unsigned int num_children; Dimension i; widget_value *cur = 0; XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xlw_tab_control_callback, (XtPointer)instance); if (val->change == STRUCTURAL_CHANGE || (val->contents && val->contents->change == STRUCTURAL_CHANGE)) { destroy_all_children (widget); build_tabs_in_widget (instance, widget, val->contents); } children = XtCompositeChildren (widget, &num_children); if (children) { for (i = 0, cur = val->contents; i < (int) num_children; i++) { if (!cur) abort (); if (children [i]->core.being_destroyed || strcmp (XtName (children [i]), cur->name)) continue; #ifdef NEED_MOTIF if (lw_motif_widget_p (children [i])) xm_update_one_widget (instance, children [i], cur, False); #endif #ifdef NEED_ATHENA if (lw_xaw_widget_p (children [i])) xaw_update_one_widget (instance, children [i], cur, False); #endif cur = cur->next; } XtFree ((char *) children); } if (cur) abort (); } #endif /* LWLIB_TABS_LUCID */ #ifdef HAVE_X_WIDGETS static Widget xlw_create_clip_window (widget_instance *instance) { Arg al[20]; int ac = 0; Widget clip = 0; widget_value* val = instance->info->val; Xt_SET_ARG (al [ac], XtNmappedWhenManaged, False); ac++; Xt_SET_ARG (al [ac], XtNsensitive, True); ac++; /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); /* Create a clip window to contain the subwidget. Incredibly the XEmacs manager seems to be the most appropriate widget for this. Nothing else is simple enough and yet does what is required. */ clip = XtCreateManagedWidget (val->name, emacsManagerWidgetClass, instance->parent, al, ac); return clip; } #endif const widget_creation_entry xlw_creation_table [] = { #ifdef LWLIB_MENUBARS_LUCID {"menubar", xlw_create_menubar}, {"popup", xlw_create_popup_menu}, #endif #ifdef LWLIB_SCROLLBARS_LUCID {"vertical-scrollbar", xlw_create_vertical_scrollbar}, {"horizontal-scrollbar", xlw_create_horizontal_scrollbar}, #endif #ifdef LWLIB_TABS_LUCID {"tab-control", xlw_create_tab_control}, #endif #ifdef HAVE_X_WIDGETS {"clip-window", xlw_create_clip_window}, #endif {NULL, NULL} }; Boolean lw_lucid_widget_p (Widget widget) { WidgetClass the_class = XtClass (widget); #ifdef LWLIB_MENUBARS_LUCID if (the_class == xlwMenuWidgetClass) return True; #endif #ifdef LWLIB_SCROLLBARS_LUCID if (the_class == xlwScrollBarWidgetClass) return True; #endif #ifdef LWLIB_TABS_LUCID if (the_class == tabsWidgetClass) return True; #endif #ifdef LWLIB_MENUBARS_LUCID if (the_class == overrideShellWidgetClass) return XtClass (((CompositeWidget)widget)->composite.children [0]) == xlwMenuWidgetClass; #endif #ifdef HAVE_X_WIDGETS if (the_class == emacsManagerWidgetClass) return True; #endif return False; } void xlw_update_one_widget (widget_instance* instance, Widget widget, widget_value* val, Boolean UNUSED (deep_p)) { WidgetClass class_ = XtClass (widget); if (0) ; #ifdef LWLIB_MENUBARS_LUCID else if (class_ == xlwMenuWidgetClass) { XlwMenuWidget mw; if (XtIsShell (widget)) mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; else mw = (XlwMenuWidget)widget; Xt_SET_VALUE (widget, XtNmenu, val); /* #### mw unused! */ } #endif #ifdef LWLIB_SCROLLBARS_LUCID else if (class_ == xlwScrollBarWidgetClass) { xlw_update_scrollbar (instance, widget, val); } #endif #ifdef LWLIB_TABS_LUCID else if (class_ == tabsWidgetClass) { xlw_update_tab_control (instance, widget, val); } #endif /* Lastly update our global arg values. */ if (val->args && val->args->nargs) XtSetValues (widget, val->args->args, val->args->nargs); } void xlw_update_one_value (widget_instance* UNUSED (instance), Widget UNUSED (widget), widget_value* UNUSED (val)) { } void xlw_pop_instance (widget_instance* UNUSED (instance), Boolean UNUSED (up)) { } #ifdef LWLIB_MENUBARS_LUCID void xlw_popup_menu (Widget widget, XEvent *event) { XlwMenuWidget mw; if (!XtIsShell (widget)) return; if (event->type == ButtonPress || event->type == ButtonRelease) { mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; xlw_pop_up_menu (mw, (XButtonPressedEvent *)event); } else abort (); } #endif /* LWLIB_MENUBARS_LUCID */ /* Destruction of instances */ void xlw_destroy_instance (widget_instance* instance) { if (instance->widget) XtDestroyWidget (instance->widget); }