This is toolbar.c in view mode; [Download] [Up]
/* Generic toolbar implementation.
Copyright (C) 1995 Board of Trustees, University of Illinois.
Copyright (C) 1995 Sun Microsystems.
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Synched up with: Not in FSF. */
#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "frame.h"
#include "device.h"
#include "glyphs.h"
#include "redisplay.h"
#include "toolbar.h"
#include "window.h"
Lisp_Object Vtop_toolbar, Vbottom_toolbar;
Lisp_Object Vleft_toolbar, Vright_toolbar;
Lisp_Object Vtop_toolbar_height, Vbottom_toolbar_height;
Lisp_Object Vleft_toolbar_width, Vright_toolbar_width;
Lisp_Object Vdefault_toolbar, Vdefault_toolbar_position;
Lisp_Object Vtoolbar_buttons_captioned_p;
/* Qdefault defined in general.c */
Lisp_Object Qtop, Qbottom, Qleft, Qright;
Lisp_Object Qtoolbar;
Lisp_Object Qtoolbar_buttonp;
Lisp_Object Q2D, Q3D, Q2d, Q3d;
Lisp_Object Q_size;
extern Lisp_Object Q_style; /* defined in menubar.c */
Lisp_Object Qinit_toolbar_from_resources;
static Lisp_Object
mark_toolbar_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
{
struct toolbar_data *data = (struct toolbar_data *) XPNTR (obj);
((markobj) (data->last_toolbar_buffer));
return (data->toolbar_buttons);
}
DEFINE_LRECORD_IMPLEMENTATION ("toolbar-data", toolbar_data,
mark_toolbar_data, 0, 0, 0, 0,
struct toolbar_data);
static Lisp_Object
mark_toolbar_button (Lisp_Object obj, void (*markobj) (Lisp_Object))
{
struct toolbar_button *data = (struct toolbar_button *) XPNTR (obj);
((markobj) (data->next));
((markobj) (data->frame));
((markobj) (data->up_glyph));
((markobj) (data->down_glyph));
((markobj) (data->disabled_glyph));
((markobj) (data->cap_up_glyph));
((markobj) (data->cap_down_glyph));
((markobj) (data->cap_disabled_glyph));
((markobj) (data->callback));
((markobj) (data->enabled_p));
return (data->help_string);
}
static void
print_toolbar_button (Lisp_Object obj, Lisp_Object printcharfun,
int escapeflag)
{
struct toolbar_button *tb = XTOOLBAR_BUTTON (obj);
char buf[100];
if (print_readably)
error ("printing unreadable object #<toolbar-button 0x%x>",
tb->header.uid);
sprintf (buf, "#<toolbar-button 0x%x>", tb->header.uid);
write_c_string (buf, printcharfun);
}
DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button,
mark_toolbar_button, print_toolbar_button,
0, 0, 0,
struct toolbar_button);
DEFUN ("toolbar-button-p", Ftoolbar_button_p, Stoolbar_button_p, 1, 1, 0,
"Return non-nil if OBJECT is a toolbar button.")
(object)
Lisp_Object object;
{
return (TOOLBAR_BUTTONP (object) ? Qt : Qnil);
}
/* Only query functions are provided for toolbar buttons. They are
generated and updated from a toolbar description list. Any
directly made changes would be wiped out the first time the toolbar
was marked as dirty and was regenerated. The exception to this is
set-toolbar-button-down-flag. Having this allows us to control the
toolbar from elisp. Since we only trigger the button callbacks on
up-mouse events and we reset the flag first, there shouldn't be any
way for this to get us in trouble (like if someone decides to
change the toolbar from a toolbar callback). */
DEFUN ("toolbar-button-callback", Ftoolbar_button_callback,
Stoolbar_button_callback, 1, 1, 0,
"Return the callback function associated with the toolbar BUTTON.")
(button)
Lisp_Object button;
{
CHECK_TOOLBAR_BUTTON (button, 0);
return (XTOOLBAR_BUTTON (button)->callback);
}
DEFUN ("toolbar-button-help-string", Ftoolbar_button_help_string,
Stoolbar_button_help_string, 1, 1, 0,
"Return the help string function associated with the toolbar BUTTON.")
(button)
Lisp_Object button;
{
CHECK_TOOLBAR_BUTTON (button, 0);
return (XTOOLBAR_BUTTON (button)->help_string);
}
DEFUN ("toolbar-button-enabled-p", Ftoolbar_button_enabled_p,
Stoolbar_button_enabled_p, 1, 1, 0,
"Return t if BUTTON is active.")
(button)
Lisp_Object button;
{
CHECK_TOOLBAR_BUTTON (button, 0);
return (XTOOLBAR_BUTTON (button)->enabled ? Qt : Qnil);
}
DEFUN ("set-toolbar-button-down-flag", Fset_toolbar_button_down_flag,
Sset_toolbar_button_down_flag, 2, 2, 0,
"Don't touch.")
(button, flag)
Lisp_Object button, flag;
{
struct toolbar_button *tb;
char old_flag;
CHECK_TOOLBAR_BUTTON (button, 0);
tb = XTOOLBAR_BUTTON (button);
old_flag = tb->down;
/* If the button is ignored, don't do anything. */
if (!tb->enabled)
return Qnil;
/* If flag is nil, unset the down flag, otherwise set it to true.
This also triggers an immediate redraw of the button if the flag
does change. */
if (NILP (flag))
tb->down = 0;
else
tb->down = 1;
if (tb->down != old_flag)
{
struct frame *f = XFRAME (tb->frame);
struct device *d;
if (DEVICEP (f->device))
{
d = XDEVICE (f->device);
if (DEVICE_LIVE_P (XDEVICE (f->device)))
{
tb->dirty = 1;
MAYBE_DEVMETH (d, output_toolbar_button, (f, button));
}
}
}
return Qnil;
}
static Lisp_Object
toolbar_from_toolbar_position (Lisp_Object position)
{
if (EQ (position, Qtop))
return Vtop_toolbar;
else if (EQ (position, Qbottom))
return Vbottom_toolbar;
else if (EQ (position, Qleft))
return Vleft_toolbar;
else if (EQ (position, Qright))
return Vright_toolbar;
signal_simple_error ("Invalid toolbar position", position);
return Qnil; /* not reached */
}
DEFUN ("set-default-toolbar-position", Fset_default_toolbar_position,
Sset_default_toolbar_position, 1, 1, 0,
"Set the position that the `default-toolbar' will be displayed at.\n\
Valid positions are 'top, 'bottom, 'left and 'right.\n\
See `default-toolbar-position'.")
(position)
Lisp_Object position;
{
Lisp_Object current_inheriting =
toolbar_from_toolbar_position (Vdefault_toolbar_position);
Lisp_Object new_inheriting =
toolbar_from_toolbar_position (position);
if (!EQ (current_inheriting, new_inheriting))
{
/* The following calls will automatically cause the dirty
flags to be set */
set_specifier_fallback (current_inheriting, Qnil);
set_specifier_fallback (new_inheriting, Vdefault_toolbar);
Vdefault_toolbar_position = position;
}
return position;
}
DEFUN ("default-toolbar-position", Fdefault_toolbar_position,
Sdefault_toolbar_position, 0, 0, 0,
"Return the position that the `default-toolbar' will be displayed at.\n\
The `default-toolbar' will only be displayed here if the corresponding\n\
position-specific toolbar specifier does not provide a value.")
()
{
return Vdefault_toolbar_position;
}
static Lisp_Object
update_toolbar_button (struct frame *f, struct toolbar_button *tb,
Lisp_Object desc, int pushright)
{
Lisp_Object *elt, glyphs, retval, buffer;
struct gcpro gcpro1, gcpro2;
elt = vector_data (XVECTOR (desc));
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
if (!tb)
{
tb = alloc_lcrecord (sizeof (struct toolbar_button),
lrecord_toolbar_button);
tb->next = Qnil;
XSETFRAME (tb->frame, f);
tb->up_glyph = Qnil;
tb->down_glyph = Qnil;
tb->disabled_glyph = Qnil;
tb->cap_up_glyph = Qnil;
tb->cap_down_glyph = Qnil;
tb->cap_disabled_glyph = Qnil;
tb->callback = Qnil;
tb->enabled_p = Qnil;
tb->help_string = Qnil;
tb->enabled = 0;
tb->down = 0;
tb->pushright = pushright;
tb->blank = 0;
tb->x = tb->y = tb->width = tb->height = -1;
tb->dirty = 1;
}
XSETTOOLBAR_BUTTON (retval, tb);
/* Let's make sure nothing gets mucked up by the potential call to
eval farther down. */
GCPRO2 (retval, desc);
glyphs = (CONSP (elt[0]) ? elt[0] : symbol_value_in_buffer (elt[0], buffer));
/* If this is true we have a blank, otherwise it is an actual
button. */
if (KEYWORDP (glyphs))
{
int pos;
int style_seen = 0;
int size_seen = 0;
if (!tb->blank)
{
tb->blank = 1;
tb->dirty = 1;
}
for (pos = 0; pos < vector_length (XVECTOR (desc)); pos += 2)
{
Lisp_Object key = elt[pos];
Lisp_Object val = elt[pos + 1];
if (EQ (key, Q_style))
{
style_seen = 1;
if (EQ (val, Q2D) || EQ (val, Q2d))
{
if (!EQ (Qnil, tb->up_glyph) || !EQ (Qt, tb->disabled_glyph))
{
tb->up_glyph = Qnil;
tb->disabled_glyph = Qt;
tb->dirty = 1;
}
}
else if (EQ (val, Q3D) || (EQ (val, Q3d)))
{
if (!EQ (Qt, tb->up_glyph) || !EQ (Qnil, tb->disabled_glyph))
{
tb->up_glyph = Qt;
tb->disabled_glyph = Qnil;
tb->dirty = 1;
}
}
}
else if (EQ (key, Q_size))
{
size_seen = 1;
if (!EQ (val, tb->down_glyph))
{
tb->down_glyph = val;
tb->dirty = 1;
}
}
}
if (!style_seen)
{
/* The default style is 3D. */
if (!EQ (Qt, tb->up_glyph) || !EQ (Qnil, tb->disabled_glyph))
{
tb->up_glyph = Qt;
tb->disabled_glyph = Qnil;
tb->dirty = 1;
}
}
if (!size_seen)
{
/* The default width is set to nil. The device specific
code will fill it in at its discretion. */
if (!NILP (tb->down_glyph))
{
tb->down_glyph = Qnil;
tb->dirty = 1;
}
}
/* The rest of these fields are not used by blanks. We make
sure they are nulled out in case this button object formerly
represented a real button. */
if (!NILP (tb->callback)
|| !NILP (tb->enabled_p)
|| !NILP (tb->help_string))
{
tb->cap_up_glyph = Qnil;
tb->cap_down_glyph = Qnil;
tb->cap_disabled_glyph = Qnil;
tb->callback = Qnil;
tb->enabled_p = Qnil;
tb->help_string = Qnil;
tb->dirty = 1;
}
}
else
{
if (tb->blank)
{
tb->blank = 0;
tb->dirty = 1;
}
/* We know that we at least have an up_glyph. */
if (!EQ (XCAR (glyphs), tb->up_glyph))
{
tb->up_glyph = XCAR (glyphs);
tb->dirty = 1;
}
glyphs = XCDR (glyphs);
/* We might have a down_glyph. */
if (!NILP (glyphs))
{
if (!EQ (XCAR (glyphs), tb->down_glyph))
{
tb->down_glyph = XCAR (glyphs);
tb->dirty = 1;
}
glyphs = XCDR (glyphs);
}
else
tb->down_glyph = Qnil;
/* We might have a disabled_glyph. */
if (!NILP (glyphs))
{
if (!EQ (XCAR (glyphs), tb->disabled_glyph))
{
tb->disabled_glyph = XCAR (glyphs);
tb->dirty = 1;
}
glyphs = XCDR (glyphs);
}
else
tb->disabled_glyph = Qnil;
/* We might have a cap_up_glyph. */
if (!NILP (glyphs))
{
if (!EQ (XCAR (glyphs), tb->cap_up_glyph))
{
tb->cap_up_glyph = XCAR (glyphs);
tb->dirty = 1;
}
glyphs = XCDR (glyphs);
}
else
tb->cap_up_glyph = Qnil;
/* We might have a cap_down_glyph. */
if (!NILP (glyphs))
{
if (!EQ (XCAR (glyphs), tb->cap_down_glyph))
{
tb->cap_down_glyph = XCAR (glyphs);
tb->dirty = 1;
}
glyphs = XCDR (glyphs);
}
else
tb->cap_down_glyph = Qnil;
/* We might have a cap_disabled_glyph. */
if (!NILP (glyphs))
{
if (!EQ (XCAR (glyphs), tb->cap_disabled_glyph))
{
tb->cap_disabled_glyph = XCAR (glyphs);
tb->dirty = 1;
}
}
else
tb->cap_disabled_glyph = Qnil;
/* Update the callback. */
if (!EQ (tb->callback, elt[1]))
{
tb->callback = elt[1];
/* This does not have an impact on the display properties of the
button so we do not mark it as dirty if it has changed. */
}
/* Update the enabled field. */
if (!EQ (tb->enabled_p, elt[2]))
{
tb->enabled_p = elt[2];
tb->dirty = 1;
}
/* We always do the following because if the enabled status is
determined by a function its decision may change without us being
able to detect it. */
{
int old_enabled = tb->enabled;
if (NILP (tb->enabled_p))
tb->enabled = 0;
else if (EQ (tb->enabled_p, Qt))
tb->enabled = 1;
else
{
if (NILP (tb->enabled_p) || EQ (tb->enabled_p, Qt))
/* short-circuit the common case for speed */
tb->enabled = !NILP (tb->enabled_p);
else
{
Lisp_Object result =
eval_in_buffer_trapping_errors
("Error in toolbar enabled-p form",
XBUFFER
(WINDOW_BUFFER
(XWINDOW (FRAME_SELECTED_WINDOW (f)))),
tb->enabled_p);
if (UNBOUNDP (result))
/* #### if there was an error in the enabled-p
form, should we pretend like it's enabled
or disabled? */
tb->enabled = 0;
else
tb->enabled = !NILP (result);
}
}
if (old_enabled != tb->enabled)
tb->dirty = 1;
}
/* Update the help echo string. */
if (!EQ (tb->help_string, elt[3]))
{
tb->help_string = elt[3];
/* This does not have an impact on the display properties of the
button so we do not mark it as dirty if it has changed. */
}
}
/* If this flag changes, the position is changing for sure unless
some very unlikely geometry occurs. */
if (tb->pushright != pushright)
{
tb->pushright = pushright;
tb->dirty = 1;
}
/* The position and size fields are only manipulated in the
device-dependent code. */
UNGCPRO;
return retval;
}
static Lisp_Object
compute_frame_toolbar_buttons (struct frame *f, enum toolbar_pos pos,
Lisp_Object toolbar)
{
Lisp_Object buttons, prev_button, first_button;
Lisp_Object orig_toolbar = toolbar;
int pushright_seen = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
first_button = FRAME_TOOLBAR_DATA (f, pos)->toolbar_buttons;
buttons = prev_button = first_button;
/* Yes, we're being paranoid. */
GCPRO5 (toolbar, buttons, prev_button, first_button, orig_toolbar);
if (NILP (toolbar))
{
/* The output mechanisms will take care of clearing the former
toolbar. */
UNGCPRO;
return Qnil;
}
if (!CONSP (toolbar))
{
UNGCPRO;
signal_simple_error ("toolbar description must be a list", toolbar);
}
/* First synchronize any existing buttons. */
while (!NILP (toolbar) && !NILP (buttons))
{
struct toolbar_button *tb;
if (NILP (XCAR (toolbar)))
{
if (pushright_seen)
{
UNGCPRO;
signal_simple_error
("more than one partition (nil) in toolbar description",
orig_toolbar);
}
else
pushright_seen = 1;
}
else
{
tb = XTOOLBAR_BUTTON (buttons);
update_toolbar_button (f, tb, XCAR (toolbar), pushright_seen);
prev_button = buttons;
buttons = tb->next;
}
toolbar = XCDR (toolbar);
}
/* If we hit the end of the toolbar, then clean up any excess
buttons and return. */
if (NILP (toolbar))
{
if (!NILP (buttons))
{
/* If this is the case the the only thing we saw was a
pushright marker. */
if (EQ (buttons, first_button))
{
UNGCPRO;
return Qnil;
}
else
XTOOLBAR_BUTTON (prev_button)->next = Qnil;
}
UNGCPRO;
return first_button;
}
/* At this point there are more buttons on the toolbar than we
actually have in existence. */
while (!NILP (toolbar))
{
Lisp_Object new_button;
if (NILP (XCAR (toolbar)))
{
if (pushright_seen)
{
UNGCPRO;
signal_simple_error
("more than one partition (nil) in toolbar description",
orig_toolbar);
}
else
pushright_seen = 1;
}
else
{
new_button = update_toolbar_button (f, NULL, XCAR (toolbar),
pushright_seen);
if (NILP (first_button))
{
first_button = prev_button = new_button;
}
else
{
XTOOLBAR_BUTTON (prev_button)->next = new_button;
prev_button = new_button;
}
}
toolbar = XCDR (toolbar);
}
UNGCPRO;
return first_button;
}
static int
set_frame_toolbar (struct frame *f, enum toolbar_pos pos, int first_time_p)
{
Lisp_Object toolbar, buttons;
Lisp_Object buffer = XWINDOW (f->selected_window)->buffer;
int size = 0;
switch (pos)
{
case TOP_TOOLBAR:
toolbar = Fspecifier_instance (Vtop_toolbar,
f->selected_window, Qnil, Qnil);
break;
case BOTTOM_TOOLBAR:
toolbar = Fspecifier_instance (Vbottom_toolbar,
f->selected_window, Qnil, Qnil);
break;
case LEFT_TOOLBAR:
toolbar = Fspecifier_instance (Vleft_toolbar,
f->selected_window, Qnil, Qnil);
break;
case RIGHT_TOOLBAR:
toolbar = Fspecifier_instance (Vright_toolbar,
f->selected_window, Qnil, Qnil);
break;
default:
abort ();
}
size = XINT (f->toolbar_size[pos]);
if (NILP (f->toolbar_data[pos]))
{
struct toolbar_data *td = alloc_lcrecord (sizeof (struct toolbar_data),
lrecord_toolbar_data);
td->last_toolbar_buffer = Qnil;
td->toolbar_buttons = Qnil;
XSETTOOLBAR_DATA (f->toolbar_data[pos], td);
}
if (size)
buttons = compute_frame_toolbar_buttons (f, pos, toolbar);
else
buttons = Qnil;
FRAME_TOOLBAR_DATA (f, pos)->last_toolbar_buffer = buffer;
FRAME_TOOLBAR_DATA (f, pos)->toolbar_buttons = buttons;
return (size && !NILP (toolbar));
}
#define COMPUTE_TOOLBAR_DATA(position) \
do \
{ \
toolbar_changed = \
(f->toolbar_changed \
|| NILP (f->toolbar_data[position]) \
|| (!EQ (FRAME_TOOLBAR_DATA (f, position)->last_toolbar_buffer, \
XWINDOW (f->selected_window)->buffer))); \
\
toolbar_was_visible = \
(!NILP (f->toolbar_data[position]) \
&& !NILP (FRAME_TOOLBAR_DATA (f, position)->toolbar_buttons));\
toolbar_will_be_visible = toolbar_was_visible; \
\
if (toolbar_changed) \
toolbar_will_be_visible = \
set_frame_toolbar (f, position, first_time_p); \
\
toolbar_visibility_changed = \
(toolbar_was_visible != toolbar_will_be_visible); \
\
if (toolbar_visibility_changed) \
frame_changed_size = 1; \
} while (0)
static void
compute_frame_toolbars_data (struct frame *f, int first_time_p)
{
int toolbar_changed;
int toolbar_was_visible, toolbar_will_be_visible;
int toolbar_visibility_changed;
int frame_changed_size = 0;
COMPUTE_TOOLBAR_DATA (TOP_TOOLBAR);
COMPUTE_TOOLBAR_DATA (BOTTOM_TOOLBAR);
COMPUTE_TOOLBAR_DATA (LEFT_TOOLBAR);
COMPUTE_TOOLBAR_DATA (RIGHT_TOOLBAR);
/* The frame itself doesn't actually change size, but the usable
text area does. All we have to do is call change_frame_size with
the current height and width parameters and it will readjust for
all changes in the toolbars. */
if (frame_changed_size && !first_time_p)
change_frame_size (f, FRAME_HEIGHT (f), FRAME_WIDTH (f), 0, 0);
}
#undef COMPUTE_TOOLBAR_DATA
void
update_frame_toolbars (struct frame *f)
{
struct device *d = XDEVICE (f->device);
Lisp_Object buffer = XWINDOW (f->selected_window)->buffer;
/* If the buffer of the selected window is not equal to the
last_toolbar_buffer value for any of the toolbars, then the
toolbars need to be recomputed. */
if ((HAS_DEVMETH_P (d, output_frame_toolbars))
&& (f->toolbar_changed
|| !EQ (FRAME_TOOLBAR_BUFFER (f, TOP_TOOLBAR), buffer)
|| !EQ (FRAME_TOOLBAR_BUFFER (f, BOTTOM_TOOLBAR), buffer)
|| !EQ (FRAME_TOOLBAR_BUFFER (f, LEFT_TOOLBAR), buffer)
|| !EQ (FRAME_TOOLBAR_BUFFER (f, RIGHT_TOOLBAR), buffer)))
{
/* The minibuffer isn't allowed to alter the toolbar. We still
output any existing toolbar information to ensure that it
gets redrawn properly. */
if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
compute_frame_toolbars_data (f, 0);
DEVMETH (d, output_frame_toolbars, (f));
}
f->toolbar_changed = 0;
}
void
init_frame_toolbars (struct frame *f)
{
struct device *d = XDEVICE (f->device);
/* If there isn't any output routine, then this device type doesn't
support toolbars. */
if (HAS_DEVMETH_P (d, output_frame_toolbars))
{
Lisp_Object frame = Qnil;
compute_frame_toolbars_data (f, 1);
XSETFRAME (frame, f);
call_critical_lisp_code (XDEVICE (FRAME_DEVICE (f)),
Qinit_toolbar_from_resources,
frame);
MAYBE_DEVMETH (d, initialize_frame_toolbars, (f));
}
}
void
init_device_toolbars (struct device *d)
{
Lisp_Object device = Qnil;
XSETDEVICE (device, d);
if (HAS_DEVMETH_P (d, output_frame_toolbars))
call_critical_lisp_code (d,
Qinit_toolbar_from_resources,
device);
}
void
init_global_toolbars (struct device *d)
{
if (HAS_DEVMETH_P (d, output_frame_toolbars))
call_critical_lisp_code (d,
Qinit_toolbar_from_resources,
Qglobal);
}
void
free_frame_toolbars (struct frame *f)
{
struct device *d = XDEVICE (f->device);
/* If we had directly allocated any memory for the toolbars instead
of using all Lisp_Objects this is where we would now free it. */
MAYBE_DEVMETH (d, free_frame_toolbars, (f));
}
void
get_toolbar_coords (struct frame *f, enum toolbar_pos pos, int *x, int *y,
int *width, int *height, int *vert, int for_layout)
{
int visible_top_toolbar_height, visible_bottom_toolbar_height;
int adjust = (for_layout ? 1 : 0);
/* The top and bottom toolbars take precedence over the left and
right. */
visible_top_toolbar_height = (FRAME_TOP_TOOLBAR_VISIBLE (f)
? FRAME_TOP_TOOLBAR_HEIGHT (f)
: 0);
visible_bottom_toolbar_height = (FRAME_BOTTOM_TOOLBAR_VISIBLE (f)
? FRAME_BOTTOM_TOOLBAR_HEIGHT (f)
: 0);
/* We adjust the width and height by one to give us a narrow border
at the ouside edges. However, when we are simply determining
toolbar location we don't want to do that. */
switch (pos)
{
case TOP_TOOLBAR:
*x = 1;
*y = 0; /* #### should be 1 if no menubar */
*width = FRAME_PIXWIDTH (f) - 2;
*height = FRAME_TOP_TOOLBAR_HEIGHT (f) - adjust;
*vert = 0;
break;
case BOTTOM_TOOLBAR:
*x = 1;
*y = FRAME_PIXHEIGHT (f) - FRAME_BOTTOM_TOOLBAR_HEIGHT (f);
*width = FRAME_PIXWIDTH (f) - 2;
*height = FRAME_BOTTOM_TOOLBAR_HEIGHT (f) - adjust;
*vert = 0;
break;
case LEFT_TOOLBAR:
*x = 1;
*y = visible_top_toolbar_height;
*width = FRAME_LEFT_TOOLBAR_WIDTH (f) - adjust;
*height = (FRAME_PIXHEIGHT (f) - visible_top_toolbar_height -
visible_bottom_toolbar_height - 1);
*vert = 1;
break;
case RIGHT_TOOLBAR:
*x = FRAME_PIXWIDTH (f) - FRAME_RIGHT_TOOLBAR_WIDTH (f);
*y = visible_top_toolbar_height;
*width = FRAME_RIGHT_TOOLBAR_WIDTH (f) - adjust;
*height = (FRAME_PIXHEIGHT (f) - visible_top_toolbar_height -
visible_bottom_toolbar_height);
*vert = 1;
break;
default:
abort ();
}
}
#define CHECK_TOOLBAR(pos) \
do \
{ \
get_toolbar_coords (f, pos, &x, &y, &width, &height, &vert, 0); \
if ((x_coord >= x) && (x_coord < (x + width))) \
{ \
if ((y_coord >= y) && (y_coord < (y + height))) \
{ \
return (FRAME_TOOLBAR_DATA (f, pos)->toolbar_buttons); \
} \
} \
} while (0)
static Lisp_Object
toolbar_buttons_at_pixpos (struct frame *f, int x_coord, int y_coord)
{
int x, y, width, height, vert;
if (FRAME_TOP_TOOLBAR_VISIBLE (f))
CHECK_TOOLBAR (TOP_TOOLBAR);
if (FRAME_BOTTOM_TOOLBAR_VISIBLE (f))
CHECK_TOOLBAR (BOTTOM_TOOLBAR);
if (FRAME_LEFT_TOOLBAR_VISIBLE (f))
CHECK_TOOLBAR (LEFT_TOOLBAR);
if (FRAME_RIGHT_TOOLBAR_VISIBLE (f))
CHECK_TOOLBAR (RIGHT_TOOLBAR);
return Qnil;
}
#undef CHECK_TOOLBAR
/* The device dependent code actually does the work of positioning the
buttons, but we are free to access that information at this
level. */
Lisp_Object
toolbar_button_at_pixpos (struct frame *f, int x_coord, int y_coord)
{
Lisp_Object buttons = toolbar_buttons_at_pixpos (f, x_coord, y_coord);
if (NILP (buttons))
return Qnil;
while (!NILP (buttons))
{
struct toolbar_button *tb = XTOOLBAR_BUTTON (buttons);
if ((x_coord >= tb->x) && (x_coord < (tb->x + tb->width)))
{
if ((y_coord >= tb->y) && (y_coord < (tb->y + tb->height)))
{
/* If we are over a blank, return nil. */
if (tb->blank)
return Qnil;
else
return buttons;
}
}
buttons = tb->next;
}
/* We must be over a blank in the toolbar. */
return Qnil;
}
/************************************************************************/
/* Toolbar specifier type */
/************************************************************************/
DEFINE_SPECIFIER_TYPE (toolbar);
#define CTB_ERROR(msg) \
do { \
if (!NILP (no_error)) \
return Qnil; \
else \
signal_simple_error (msg, button); \
} while (0)
/* Returns Q_style if key was :style, Qt if ok otherwise, Qnil if error. */
static Lisp_Object
check_toolbar_button_keywords (Lisp_Object button, Lisp_Object key,
Lisp_Object val, Lisp_Object no_error)
{
if (!KEYWORDP (key))
{
if (!NILP (no_error))
return Qnil;
else
signal_simple_error_2 ("not a keyword", key, button);
}
if (EQ (key, Q_style))
{
if (!EQ (val, Q2D)
&& !EQ (val, Q3D)
&& !EQ (val, Q2d)
&& !EQ (val, Q3d))
CTB_ERROR ("unrecognized toolbar blank style");
return Q_style;
}
else if (EQ (key, Q_size))
{
if (!NATNUMP (val))
CTB_ERROR ("invalid toolbar blank size");
}
else
{
CTB_ERROR ("invalid toolbar blank keyword");
}
return Qt;
}
/* toolbar button spec is [pixmap-pair function enabled-p help]
or [:style 2d-or-3d :size width-or-height] */
DEFUN ("check-toolbar-button-syntax", Fcheck_toolbar_button_syntax,
Scheck_toolbar_button_syntax, 1, 2, 0,
"Verify the syntax of entry BUTTON in a toolbar description list.\n\
If you want to verify the syntax of a toolbar description list as a\n\
whole, use `check-valid-instantiator' with a specifier type of 'toolbar.")
(button, no_error)
Lisp_Object button, no_error;
{
Lisp_Object *elt, glyphs, value;
int len;
if (!VECTORP (button))
CTB_ERROR ("toolbar button descriptors must be vectors");
elt = vector_data (XVECTOR (button));
if (vector_length (XVECTOR (button)) == 2)
{
if (!EQ (Q_style, check_toolbar_button_keywords (button, elt[0],
elt[1], no_error)))
CTB_ERROR ("must specify toolbar blank style");
return Qt;
}
if (vector_length (XVECTOR (button)) != 4)
CTB_ERROR ("toolbar button descriptors must be 2 or 4 long");
/* The first element must be a list of glyphs of length 1-6. The
first entry is the pixmap for the up state, the second for the
down state, the third for the disabled state, the fourth for the
captioned up state, the fifth for the captioned down state and
the sixth for the captioned disabled state. Only the up state is
mandatory. */
if (!CONSP (elt[0]))
{
/* We can't check the buffer-local here because we don't know
which buffer to check in. #### I think this is a bad thing.
See if we can't get enough information to this function so
that it can check. */
value = Fsymbol_value (elt[0]);
if (!CONSP (value))
{
if (KEYWORDP (elt[0]))
{
int fsty = 0;
if (EQ (Q_style, check_toolbar_button_keywords (button, elt[0],
elt[1],
no_error)))
fsty++;
if (EQ (Q_style, check_toolbar_button_keywords (button, elt[2],
elt[3],
no_error)))
fsty++;
if (!fsty)
CTB_ERROR ("must specify toolbar blank style");
else if (EQ (elt[0], elt[2]))
CTB_ERROR
("duplicate keywords in toolbar button blank description");
return Qt;
}
else
CTB_ERROR ("first element of button must be a list (of glyphs)");
}
}
else
value = elt[0];
len = XINT (Flength (value));
if (len < 1)
CTB_ERROR ("toolbar button glyph list must have at least 1 entry");
if (len > 6)
CTB_ERROR ("toolbar button glyph list can have at most 6 entries");
glyphs = value;
while (!NILP (glyphs))
{
if (!GLYPHP (XCAR (glyphs)))
{
/* We allow nil for the down and disabled glyphs but not for
the up glyph. */
if (EQ (glyphs, value) || !NILP (XCAR (glyphs)))
{
CTB_ERROR
("all elements of toolbar button glyph list must be glyphs.");
}
}
glyphs = XCDR (glyphs);
}
/* The second element is the function to run when the button is
activated. We do not do any checking on it because it is legal
for the function to not be defined until after the toolbar is.
It is the user's problem to get this right.
The third element is either a boolean indicating the enabled
status or a function used to determine it. Again, it is the
user's problem if this is wrong.
The fourth element, if not nil, must be a string which will be
displayed as the help echo. */
/* #### This should be allowed to be a function returning a string
as well as just a string. */
if (!NILP (elt[3]) && !STRINGP (elt[3]))
CTB_ERROR ("toolbar button help echo string must be a string");
return Qt;
}
#undef CTB_ERROR
static int
toolbar_validate (Lisp_Object instantiator, int no_error)
{
int pushright_seen = 0;
Lisp_Object rest;
if (NILP (instantiator))
return 1;
if (!CONSP (instantiator))
{
if (!no_error)
signal_simple_error ("toolbar spec must be list or nil",
instantiator);
else
return 0;
}
for (rest = instantiator; !NILP (rest); rest = XCDR (rest))
{
if (!CONSP (rest))
{
if (!no_error)
signal_simple_error ("bad list in toolbar spec",
instantiator);
else
return 0;
}
if (NILP (XCAR (rest)))
{
if (pushright_seen)
{
if (!no_error)
error
("more than one partition (nil) in instantiator description");
else
return 0;
}
else
pushright_seen = 1;
}
else
{
if (NILP (Fcheck_toolbar_button_syntax (XCAR (rest),
no_error ? Qt :
Qnil)))
/* if there was an explanatory error, it already got
signalled */
return 0;
}
}
return 1;
}
static void
toolbar_after_change (Lisp_Object specifier, Lisp_Object locale)
{
/* #### This is overkill. I really need to rethink the after-change
functions to make them easier to use. */
MARK_TOOLBAR_CHANGED;
}
DEFUN ("toolbar-specifier-p", Ftoolbar_specifier_p,
Stoolbar_specifier_p, 1, 1, 0,
"Return non-nil if OBJECT is an toolbar specifier.\n\
Toolbar specifiers are used to specify the format of a toolbar.\n\
The values of the variables `default-toolbar', `top-toolbar',\n\
`left-toolbar', `right-toolbar', and `bottom-toolbar' are always\n\
toolbar specifiers. See `default-toolbar' for a description\n\
of a valid toolbar instantiator.")
(object)
Lisp_Object object;
{
return (TOOLBAR_SPECIFIERP (object) ? Qt : Qnil);
}
static void
toolbar_size_changed_in_frame (Lisp_Object specifier, struct frame *f,
Lisp_Object oldval)
{
MAYBE_FRAMEMETH (f, toolbar_size_changed_in_frame,
(specifier, f, oldval));
}
void
syms_of_toolbar (void)
{
defsymbol (&Qtoolbar, "toolbar");
defsymbol (&Qtop, "top");
defsymbol (&Qbottom, "bottom");
defsymbol (&Qleft, "left");
defsymbol (&Qright, "right");
defsymbol (&Qtoolbar_buttonp, "toolbar-button-p");
defsymbol (&Q2D, "2D");
defsymbol (&Q3D, "3D");
defsymbol (&Q2d, "2d");
defsymbol (&Q3d, "3d");
defsymbol (&Q_size, ":size"); Fset (Q_size, Q_size);
defsymbol (&Qinit_toolbar_from_resources, "init-toolbar-from-resources");
defsubr (&Stoolbar_button_p);
defsubr (&Stoolbar_button_callback);
defsubr (&Stoolbar_button_help_string);
defsubr (&Stoolbar_button_enabled_p);
defsubr (&Sset_toolbar_button_down_flag);
defsubr (&Scheck_toolbar_button_syntax);
defsubr (&Sset_default_toolbar_position);
defsubr (&Sdefault_toolbar_position);
defsubr (&Stoolbar_specifier_p);
}
void
vars_of_toolbar (void)
{
staticpro (&Vdefault_toolbar_position);
Vdefault_toolbar_position = Qtop;
}
void
specifier_type_create_toolbar (void)
{
INITIALIZE_SPECIFIER_TYPE (toolbar, "toolbar", "toolbar-specifier-p");
SPECIFIER_HAS_METHOD (toolbar, validate);
SPECIFIER_HAS_METHOD (toolbar, after_change);
}
static void
toolbar_buttons_captioned_p_changed (Lisp_Object specifier, struct window *w,
Lisp_Object oldval)
{
/* This could be smarter but I doubt that it would make any
noticable difference given the infrequency with which this is
probably going to be called. */
MARK_TOOLBAR_CHANGED;
}
/* #### Do something about the unbelievable ugly contortions necessary
to set the fallback values here. */
void
specifier_vars_of_toolbar (void)
{
Lisp_Object elt;
DEFVAR_SPECIFIER ("default-toolbar", &Vdefault_toolbar,
"Specifier for a fallback toolbar.\n\
Use `set-specifier' to change this.\n\
\n\
The position of this toolbar is specified in the function\n\
`default-toolbar-position'. If the corresponding position-\n\
specific toolbar (e.g. `top-toolbar' if `default-toolbar-position'\n\
is 'top) does not specify a toolbar in a particular domain,\n\
then the value of `default-toolbar' in that domain, if any,\n\
will be used instead.\n\
\n\
Note that the toolbar at any particular position will not be\n\
displayed unless its thickness (width or height, depending on\n\
orientation) is non-zero. The thickness is controlled by the\n\
variables `top-toolbar-height', `bottom-toolbar-height',\n\
`left-toolbar-width', and `right-toolbar-width'. By default,\n\
only `top-toolbar-height' has a non-zero value.\n\
\n\
The format of the instantiator for a toolbar is a list of\n\
toolbar-button-descriptors. Each toolbar-button-descriptor\n\
is a vector in one of the following formats:\n\
\n\
[GLYPH-LIST FUNCTION ENABLED-P HELP] or\n\
[:style 2D-OR-3D] or\n\
[:style 2D-OR-3D :size WIDTH-OR-HEIGHT] or\n\
[:size WIDTH-OR-HEIGHT :style 2D-OR-3D]\n\
\n\
Optionally, one of the toolbar-button-descriptors may be nil\n\
instead of a vector; this signifies the division between\n\
the toolbar buttons that are to be displayed flush-left,\n\
and the buttons to be displayed flush-right.\n\
\n\
The first vector format above specifies a normal toolbar button;\n\
the others specify blank areas in the toolbar.\n\
\n\
For the first vector format:\n\
\n\
-- GLYPH-LIST should be a list of one to six glyphs (as created by\n\
`make-glyph') or a symbol whose value is such a list. The first\n\
glyph, which must be provided, is the glyph used to display the\n\
toolbar button when it is in the \"up\" (not pressed) state. The\n\
optional second glyph is for displaying the button when it is in\n\
the \"down\" (pressed) state. The optional third glyph is for when\n\
the button is disabled. The optional fourth, fifth and sixth glyphs\n\
are used to specify captioned versions for the up, down and disabled\n\
states respectively. The function `toolbar-make-button-list' is\n\
useful in creating these glyph lists. The specifier variable\n\
`toolbar-use-captions' controls whic glyphs are actually used.\n\
\n\
Even if you do not provide separate down-state and disabled-state\n\
glyphs, the user will still get visual feedback to indicate which\n\
state the button is in. Buttons in the up-state are displayed\n\
with a shadowed border that gives a raised appearance to the\n\
button. Buttons in the down-state are displayed with shadows that\n\
give a recessed appearance. Buttons in the disabled state and\n\
displayed with no shadows, giving a 2-d effect.\n\
\n\
-- The second element FUNCTION is a function to be called when the\n\
toolbar button is activated (i.e. when the mouse is released over\n\
the toolbar button, if the press occurred in the toolbar). It\n\
can be any form accepted by `call-interactively', since this is\n\
how it is invoked.\n\
\n\
-- The third element ENABLED-P specifies whether the toolbar button\n\
is enabled (disabled buttons do nothing when they are activated,\n\
and are displayed differently; see above). It should be either\n\
a boolean or a form that evaluates to a boolean.\n\
\n\
-- The fourth element HELP, if non-nil, should be a string. This\n\
string is displayed in the echo area when the mouse passes over\n\
the toolbar button.\n\
\n\
For the other vector formats (specifying blank areas of the toolbar):\n\
\n\
-- 2D-OR-3D should be one of the symbols '2d or '3d, indicating\n\
whether the area is displayed with shadows (giving it a raised,\n\
3-d appearance) or without shadows (giving it a flat appearance).\n\
\n\
-- WIDTH-OR-HEIGHT specifies the length, in pixels, of the blank\n\
area. If omitted, it defaults to a device-specific value\n\
(8 pixels for X devices).");
Vdefault_toolbar = Fmake_specifier (Qtoolbar);
DEFVAR_SPECIFIER ("top-toolbar", &Vtop_toolbar,
"Specifier for toolbar at the top of the frame.\n\
Use `set-specifier' to change this.\n\
See `default-toolbar' for a description of a valid toolbar instantiator.");
Vtop_toolbar = Fmake_specifier (Qtoolbar);
/* initially, top inherits from default; this can be
changed with `set-default-toolbar-position'. */
set_specifier_fallback (Vtop_toolbar, Vdefault_toolbar);
DEFVAR_SPECIFIER ("bottom-toolbar", &Vbottom_toolbar,
"Specifier for toolbar at the bottom of the frame.\n\
Use `set-specifier' to change this.\n\
See `default-toolbar' for a description of a valid toolbar instantiator.\n\
\n\
Note that by default the height of the bottom toolbar (controlled by\n\
`bottom-toolbar-height') is 0; thus, a bottom toolbar will not be\n\
displayed even if you provide a value for `bottom-toolbar'.");
Vbottom_toolbar = Fmake_specifier (Qtoolbar);
DEFVAR_SPECIFIER ("left-toolbar", &Vleft_toolbar,
"Specifier for toolbar at the left edge of the frame.\n\
Use `set-specifier' to change this.\n\
See `default-toolbar' for a description of a valid toolbar instantiator.\n\
\n\
Note that by default the width of the left toolbar (controlled by\n\
`left-toolbar-width') is 0; thus, a left toolbar will not be\n\
displayed even if you provide a value for `left-toolbar'.");
Vleft_toolbar = Fmake_specifier (Qtoolbar);
DEFVAR_SPECIFIER ("right-toolbar", &Vright_toolbar,
"Specifier for toolbar at the right edge of the frame.\n\
Use `set-specifier' to change this.\n\
See `default-toolbar' for a description of a valid toolbar instantiator.\n\
\n\
Note that by default the width of the right toolbar (controlled by\n\
`right-toolbar-width') is 0; thus, a right toolbar will not be\n\
displayed even if you provide a value for `right-toolbar'.");
Vright_toolbar = Fmake_specifier (Qtoolbar);
DEFVAR_SPECIFIER ("top-toolbar-height", &Vtop_toolbar_height,
"*Height of top toolbar.\n\
This is a specifier; use `set-specifier' to change it.");
Vtop_toolbar_height = Fmake_specifier (Qnatnum);
elt = list1 (Fcons (list1 (Qtty), Qzero));
#ifdef HAVE_X_WINDOWS
elt = Fcons (Fcons (list1 (Qx), make_number (DEFAULT_TOP_TOOLBAR_HEIGHT)), elt);
#endif
#ifdef HAVE_NEXTSTEP
elt = Fcons (Fcons (list1 (Qns), make_number (DEFAULT_TOP_TOOLBAR_HEIGHT)), elt);
#endif
set_specifier_fallback (Vtop_toolbar_height, elt);
set_specifier_caching (Vtop_toolbar_height,
slot_offset (struct window,
toolbar_size[TOP_TOOLBAR]),
some_window_value_changed,
slot_offset (struct frame,
toolbar_size[TOP_TOOLBAR]),
toolbar_size_changed_in_frame);
DEFVAR_SPECIFIER ("bottom-toolbar-height", &Vbottom_toolbar_height,
"*Height of bottom toolbar.\n\
This is a specifier; use `set-specifier' to change it.");
Vbottom_toolbar_height = Fmake_specifier (Qnatnum);
elt = list1 (Fcons (list1 (Qtty), Qzero));
#ifdef HAVE_X_WINDOWS
elt = Fcons (Fcons (list1 (Qx), make_number (DEFAULT_BOTTOM_TOOLBAR_HEIGHT)), elt);
#endif
#ifdef HAVE_NEXTSTEP
elt = Fcons (Fcons (list1 (Qns), make_number (DEFAULT_BOTTOM_TOOLBAR_HEIGHT)), elt);
#endif
set_specifier_fallback (Vbottom_toolbar_height, elt);
set_specifier_caching (Vbottom_toolbar_height,
slot_offset (struct window,
toolbar_size[BOTTOM_TOOLBAR]),
some_window_value_changed,
slot_offset (struct frame,
toolbar_size[BOTTOM_TOOLBAR]),
toolbar_size_changed_in_frame);
DEFVAR_SPECIFIER ("left-toolbar-width", &Vleft_toolbar_width,
"*Width of left toolbar.\n\
This is a specifier; use `set-specifier' to change it.");
Vleft_toolbar_width = Fmake_specifier (Qnatnum);
elt = list1 (Fcons (list1 (Qtty), Qzero));
#ifdef HAVE_X_WINDOWS
elt = Fcons (Fcons (list1 (Qx), make_number (DEFAULT_LEFT_TOOLBAR_WIDTH)), elt);
#endif
#ifdef HAVE_NEXTSTEP
elt = Fcons (Fcons (list1 (Qns), make_number (DEFAULT_LEFT_TOOLBAR_WIDTH)), elt);
#endif
set_specifier_fallback (Vleft_toolbar_width, elt);
set_specifier_caching (Vleft_toolbar_width,
slot_offset (struct window,
toolbar_size[LEFT_TOOLBAR]),
some_window_value_changed,
slot_offset (struct frame,
toolbar_size[LEFT_TOOLBAR]),
toolbar_size_changed_in_frame);
DEFVAR_SPECIFIER ("right-toolbar-width", &Vright_toolbar_width,
"*Width of right toolbar.\n\
This is a specifier; use `set-specifier' to change it.");
Vright_toolbar_width = Fmake_specifier (Qnatnum);
elt = list1 (Fcons (list1 (Qtty), Qzero));
#ifdef HAVE_X_WINDOWS
elt = Fcons (Fcons (list1 (Qx), make_number (DEFAULT_RIGHT_TOOLBAR_WIDTH)), elt);
#endif
#ifdef HAVE_NEXTSTEP
elt = Fcons (Fcons (list1 (Qns), make_number (DEFAULT_RIGHT_TOOLBAR_WIDTH)), elt);
#endif
set_specifier_fallback (Vright_toolbar_width, elt);
set_specifier_caching (Vright_toolbar_width,
slot_offset (struct window,
toolbar_size[RIGHT_TOOLBAR]),
some_window_value_changed,
slot_offset (struct frame,
toolbar_size[RIGHT_TOOLBAR]),
toolbar_size_changed_in_frame);
DEFVAR_SPECIFIER ("toolbar-buttons-captioned-p",
&Vtoolbar_buttons_captioned_p,
"*Whether the toolbar buttons are captioned.\n\
This will only have a visible effect for those toolbar buttons which had\n\
captioned versions specified.\n\
This is a specifier; use `set-specifier' to change it.");
Vtoolbar_buttons_captioned_p = Fmake_specifier (Qboolean);
set_specifier_fallback (Vtoolbar_buttons_captioned_p,
list1 (Fcons (Qnil, Qt)));
set_specifier_caching (Vtoolbar_buttons_captioned_p,
slot_offset (struct window,
toolbar_buttons_captioned_p),
toolbar_buttons_captioned_p_changed,
0, 0);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.