Pratt 1.5.6

data/pkgs/tile-0.8.2/generic/scroll.c

@@ -0,0 +1,253 @@
+/* scroll.c,v 1.9 2006/12/18 15:05:58 jenglish Exp
+ *
+ * Copyright 2004, Joe English
+ *
+ * Support routines for scrollable widgets.
+ *
+ * (This is sort of half-baked; needs some work)
+ *
+ * Scrollable interface:
+ *
+ * 	+ 'first' is controlled by [xy]view widget command 
+ * 	  and other scrolling commands like 'see';
+ *      + 'total' depends on widget contents;
+ *      + 'last' depends on first, total, and widget size.
+ *
+ * Choreography (typical usage):
+ *
+ * 	1. User adjusts scrollbar, scrollbar widget calls its -command
+ * 	2. Scrollbar -command invokes the scrollee [xy]view widget method
+ * 	3. TtkScrollviewCommand calls TtkScrollTo(), which updates 
+ * 	   'first' and schedules a redisplay.
+ * 	4. Once the scrollee knows 'total' and 'last' (typically in 
+ * 	   the LayoutProc), call TtkScrolled(h,first,last,total) to 
+ * 	   synchronize the scrollbar.
+ * 	5. The scrollee -[xy]scrollcommand is called (in an idle callback)
+ * 	6. Which calls the scrollbar 'set' method and redisplays the scrollbar.
+ *
+ * If the scrollee has internal scrolling (e.g., a 'see' method), 
+ * it should TtkScrollTo() directly (step 2).
+ *
+ * If the widget value changes, it should call TtkScrolled() (step 4).
+ * (This usually happens automatically when the widget is redisplayed).
+ *
+ * If the scrollee's -[xy]scrollcommand changes, it should call
+ * TtkScrollbarUpdateRequired, which will invoke step (5) (@@@ Fix this)
+ */
+
+#include <tk.h>
+#include "tkTheme.h"
+#include "widget.h"
+
+/* Private data:
+ */
+#define SCROLL_UPDATE_PENDING  (0x1)
+#define SCROLL_UPDATE_REQUIRED (0x2)
+
+struct ScrollHandleRec
+{
+    unsigned 	flags;
+    WidgetCore	*corePtr;
+    Scrollable	*scrollPtr;
+};
+
+/* TtkCreateScrollHandle --
+ * 	Initialize scroll handle.
+ */
+ScrollHandle TtkCreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr)
+{
+    ScrollHandle h = (ScrollHandle)ckalloc(sizeof(*h));
+
+    h->flags = 0;
+    h->corePtr = corePtr;
+    h->scrollPtr = scrollPtr;
+
+    scrollPtr->first = 0;
+    scrollPtr->last = 1;
+    scrollPtr->total = 1;
+    return h;
+}
+
+/* UpdateScrollbar --
+ *	Call the -scrollcommand callback to sync the scrollbar.
+ * 	Returns: Whatever the -scrollcommand does.
+ */
+static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h)
+{
+    Scrollable *s = h->scrollPtr;
+    WidgetCore *corePtr = h->corePtr;
+    char args[TCL_DOUBLE_SPACE * 2];
+    int code;
+
+    h->flags &= ~SCROLL_UPDATE_REQUIRED;
+
+    if (s->scrollCmd == NULL) {
+	return TCL_OK;
+    }
+
+    sprintf(args, " %g %g",
+		(double)s->first / s->total,
+		(double)s->last / s->total);
+
+    Tcl_Preserve(corePtr);
+    code = Tcl_VarEval(interp, s->scrollCmd, args, NULL);
+    if (WidgetDestroyed(corePtr)) {
+	Tcl_Release(corePtr);
+	return TCL_ERROR;
+    }
+    Tcl_Release(corePtr);
+
+    if (code != TCL_OK && !Tcl_InterpDeleted(interp)) {
+	/* Disable the -scrollcommand, add to stack trace:
+	 */
+	ckfree(s->scrollCmd);
+	s->scrollCmd = 0;
+
+	Tcl_AddErrorInfo(interp, /* @@@ "horizontal" / "vertical" */
+		"\n    (scrolling command executed by ");
+	Tcl_AddErrorInfo(interp, Tk_PathName(h->corePtr->tkwin));
+	Tcl_AddErrorInfo(interp, ")");
+    }
+    return code;
+}
+
+/* UpdateScrollbarBG --
+ * 	Idle handler to update the scrollbar.
+ */
+static void UpdateScrollbarBG(ClientData clientData)
+{
+    ScrollHandle h = (ScrollHandle)clientData;
+    Tcl_Interp *interp = h->corePtr->interp;
+    int code;
+
+    h->flags &= ~SCROLL_UPDATE_PENDING;
+    Tcl_Preserve((ClientData) interp);
+    code = UpdateScrollbar(interp, h);
+    if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
+	Tcl_BackgroundError(interp);
+    }
+    Tcl_Release((ClientData) interp);
+}
+
+/* TtkScrolled --
+ * 	Update scroll info, schedule scrollbar update.
+ */
+void TtkScrolled(ScrollHandle h, int first, int last, int total)
+{
+    Scrollable *s = h->scrollPtr;
+    
+    /* Sanity-check inputs:
+     */
+    if (total <= 0) {
+	first = 0;
+	last = 1;
+	total = 1;
+    }
+
+    if (last > total) {
+	first -= (last - total);
+	if (first < 0) first = 0;
+	last = total;
+    }
+
+    if (s->first != first || s->last != last || s->total != total
+	    || (h->flags & SCROLL_UPDATE_REQUIRED))
+    {
+	s->first = first;
+	s->last = last;
+	s->total = total;
+
+	if (!(h->flags & SCROLL_UPDATE_PENDING)) {
+	    Tcl_DoWhenIdle(UpdateScrollbarBG, (ClientData)h);
+	    h->flags |= SCROLL_UPDATE_PENDING;
+	}
+    }
+}
+
+/* TtkScrollbarUpdateRequired --
+ * 	Force a scrollbar update at the next call to TtkScrolled(),
+ * 	even if scroll parameters haven't changed (e.g., if
+ * 	-yscrollcommand has changed).
+ */
+
+void TtkScrollbarUpdateRequired(ScrollHandle h)
+{
+    h->flags |= SCROLL_UPDATE_REQUIRED;
+}
+
+/* TtkScrollviewCommand --
+ * 	Widget [xy]view command implementation.
+ *
+ *  $w [xy]view -- return current view region
+ *  $w [xy]view $index -- set topmost item
+ *  $w [xy]view moveto $fraction
+ *  $w [xy]view scroll $number $what -- scrollbar interface
+ */
+int TtkScrollviewCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle h)
+{
+    Scrollable *s = h->scrollPtr;
+    int newFirst = s->first;
+
+    if (objc == 2) {
+	char buf[TCL_DOUBLE_SPACE * 2];
+	sprintf(buf, "%g %g",
+		(double)s->first / s->total,
+		(double)s->last / s->total);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	return TCL_OK;
+    } else if (objc == 3) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &newFirst) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	double fraction;
+	int count;
+
+	switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
+	    case TK_SCROLL_ERROR:
+		return TCL_ERROR;
+	    case TK_SCROLL_MOVETO:
+		newFirst = (int) ((fraction * s->total) + 0.5);
+		break;
+	    case TK_SCROLL_UNITS:
+		newFirst = s->first + count;
+		break;
+	    case TK_SCROLL_PAGES: {
+		int perPage = s->last - s->first;	/* @@@ */
+		newFirst = s->first + count * perPage;
+		break;
+	    }
+	}
+    }
+
+    TtkScrollTo(h, newFirst);
+
+    return TCL_OK;
+}
+
+void TtkScrollTo(ScrollHandle h, int newFirst)
+{
+    Scrollable *s = h->scrollPtr;
+
+    if (newFirst >= s->total)
+	newFirst = s->total - 1;
+    if (newFirst > s->first && s->last >= s->total) /* don't scroll past end */
+	newFirst = s->first;
+    if (newFirst < 0)
+	newFirst = 0;
+
+    if (newFirst != s->first) {
+	s->first = newFirst;
+	TtkRedisplayWidget(h->corePtr);
+    }
+}
+
+void TtkFreeScrollHandle(ScrollHandle h)
+{
+    if (h->flags & SCROLL_UPDATE_PENDING) {
+	Tcl_CancelIdleCall(UpdateScrollbarBG, (ClientData)h);
+    }
+    ckfree((ClientData)h);
+}
+

data/pkgs/tile-0.8.2/generic/scrollbar.c

@@ -0,0 +1,346 @@
+/* scrollbar.c,v 1.49 2007/10/25 06:42:47 jenglish Exp
+ * Copyright (c) 2003, Joe English
+ *
+ * ttk::scrollbar widget.
+ */
+
+#include <tk.h>
+
+#include "tkTheme.h"
+#include "widget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar widget record.
+ */
+typedef struct
+{
+    Tcl_Obj	*commandObj;
+
+    int 	orient;
+    Tcl_Obj	*orientObj;
+
+    double	first;			/* top fraction */
+    double	last;			/* bottom fraction */
+
+    Ttk_Box	troughBox;		/* trough parcel */ 
+    int 	minSize;		/* minimum size of thumb */
+} ScrollbarPart;
+
+typedef struct
+{
+    WidgetCore core;
+    ScrollbarPart scrollbar;
+} Scrollbar;
+
+static Tk_OptionSpec ScrollbarOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-command", "command", "Command", "",
+	Tk_Offset(Scrollbar,scrollbar.commandObj), -1, 0,0,0},
+
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "vertical",
+	Tk_Offset(Scrollbar,scrollbar.orientObj),
+	Tk_Offset(Scrollbar,scrollbar.orient),
+	0,(ClientData)ttkOrientStrings,STYLE_CHANGED },
+
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget hooks.
+ */
+
+static int 
+ScrollbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    sb->scrollbar.first = 0.0;
+    sb->scrollbar.last = 1.0;
+
+    TtkTrackElementState(&sb->core);
+
+    return TCL_OK;
+}
+
+static Ttk_Layout ScrollbarGetLayout(
+    Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    return TtkWidgetGetOrientedLayout(
+	interp, theme, recordPtr, sb->scrollbar.orientObj);
+}
+
+/*
+ * ScrollbarDoLayout --
+ * 	Layout hook.  Adjusts the position of the scrollbar thumb.
+ *
+ * Side effects:
+ * 	Sets sb->troughBox and sb->minSize.
+ */
+static void ScrollbarDoLayout(void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    WidgetCore *corePtr = &sb->core;
+    Ttk_LayoutNode *thumb;
+    Ttk_Box thumbBox;
+    int thumbWidth, thumbHeight;
+    double first, last, size;
+    int minSize;
+
+    /*
+     * Use generic layout manager to compute initial layout:
+     */
+    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+    /*
+     * Locate thumb element, extract parcel and requested minimum size:
+     */
+    thumb = Ttk_LayoutFindNode(corePtr->layout, "thumb");
+    if (!thumb)	/* Something has gone wrong -- bail */
+	return;
+
+    sb->scrollbar.troughBox = thumbBox = Ttk_LayoutNodeParcel(thumb);
+    Ttk_LayoutNodeReqSize(
+	corePtr->layout, thumb, &thumbWidth,&thumbHeight);
+
+    /*
+     * Adjust thumb element parcel:
+     */
+    first = sb->scrollbar.first;
+    last  = sb->scrollbar.last;
+
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	minSize = thumbHeight;
+	size = thumbBox.height - minSize;
+	thumbBox.y += (int)(size * first);
+	thumbBox.height = (int)(size * last) + minSize - (int)(size * first);
+    } else {
+	minSize = thumbWidth;
+	size = thumbBox.width - minSize;
+	thumbBox.x += (int)(size * first);
+	thumbBox.width = (int)(size * last) + minSize - (int)(size * first);
+    }
+    sb->scrollbar.minSize = minSize;
+    Ttk_PlaceLayoutNode(corePtr->layout, thumb, thumbBox);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $sb set $first $last --
+ * 	Set the position of the scrollbar.
+ */
+static int
+ScrollbarSetCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+    Scrollbar *scrollbar = recordPtr;
+    Tcl_Obj *firstObj, *lastObj;
+    double first, last;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "first last");
+	return TCL_ERROR;
+    }
+
+    firstObj = objv[2];
+    lastObj = objv[3];
+    if (Tcl_GetDoubleFromObj(interp, firstObj, &first) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, lastObj, &last) != TCL_OK)
+	return TCL_ERROR;
+
+    /* Range-checks:
+     */
+    if (first < 0.0) {
+	first = 0.0;
+    } else if (first > 1.0) {
+	first = 1.0;
+    }
+
+    if (last < first) {
+	last = first;
+    } else if (last > 1.0) {
+	last = 1.0;
+    }
+
+    /* ASSERT: 0.0 <= first <= last <= 1.0 */
+
+    scrollbar->scrollbar.first = first;
+    scrollbar->scrollbar.last = last;
+    if (first <= 0.0 && last >= 1.0) {
+	scrollbar->core.state |= TTK_STATE_DISABLED;
+    } else {
+	scrollbar->core.state &= ~TTK_STATE_DISABLED;
+    }
+
+    TtkRedisplayWidget(&scrollbar->core);
+
+    return TCL_OK;
+}
+
+/* $sb get --
+ * 	Returns the last thing passed to 'set'.
+ */
+static int
+ScrollbarGetCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+    Scrollbar *scrollbar = recordPtr;
+    Tcl_Obj *result[2];
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, "");
+	return TCL_ERROR;
+    }
+
+    result[0] = Tcl_NewDoubleObj(scrollbar->scrollbar.first);
+    result[1] = Tcl_NewDoubleObj(scrollbar->scrollbar.last);
+    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+
+    return TCL_OK;
+}
+
+/* $sb delta $dx $dy --
+ * 	Returns the percentage change corresponding to a mouse movement
+ * 	of $dx, $dy.
+ */
+static int
+ScrollbarDeltaCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    double dx, dy;
+    double delta = 0.0;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "dx dy");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetDoubleFromObj(interp, objv[2], &dx) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, objv[3], &dy) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    delta = 0.0;
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	int size = sb->scrollbar.troughBox.height - sb->scrollbar.minSize;
+	if (size > 0) {
+	    delta = (double)dy / (double)size;
+	}
+    } else {
+	int size = sb->scrollbar.troughBox.width - sb->scrollbar.minSize;
+	if (size > 0) {
+	    delta = (double)dx / (double)size;
+	}
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(delta));
+    return TCL_OK;
+}
+
+/* $sb fraction $x $y --
+ * 	Returns a real number between 0 and 1 indicating  where  the
+ * 	point given by x and y lies in the trough area of the scrollbar. 
+ */
+static int
+ScrollbarFractionCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    Ttk_Box b = sb->scrollbar.troughBox;
+    int minSize = sb->scrollbar.minSize;
+    double x, y;
+    double fraction = 0.0;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "x y");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetDoubleFromObj(interp, objv[2], &x) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, objv[3], &y) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    fraction = 0.0;
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	if (b.height > minSize) {
+	    fraction = (double)(y - b.y) / (double)(b.height - minSize);
+	}
+    } else {
+	if (b.width > minSize) {
+	    fraction = (double)(x - b.x) / (double)(b.width - minSize);
+	}
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction));
+    return TCL_OK;
+}
+
+static WidgetCommandSpec ScrollbarCommands[] =
+{
+    { "configure",	TtkWidgetConfigureCommand },
+    { "cget",		TtkWidgetCgetCommand },
+    { "delta",    	ScrollbarDeltaCommand },
+    { "fraction",    	ScrollbarFractionCommand },
+    { "get",    	ScrollbarGetCommand },
+    { "identify",	TtkWidgetIdentifyCommand },
+    { "instate",	TtkWidgetInstateCommand },
+    { "set",  		ScrollbarSetCommand },
+    { "state",  	TtkWidgetStateCommand },
+    { 0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+static WidgetSpec ScrollbarWidgetSpec =
+{
+    "TScrollbar",		/* className */
+    sizeof(Scrollbar),		/* recordSize */
+    ScrollbarOptionSpecs,	/* optionSpecs */
+    ScrollbarCommands,		/* subcommands */
+    ScrollbarInitialize,	/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    TtkNullPostConfigure,	/* postConfigureProc */
+    ScrollbarGetLayout,		/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    ScrollbarDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(VerticalScrollbarLayout)
+    TTK_GROUP("Vertical.Scrollbar.trough", TTK_FILL_Y,
+	TTK_NODE("Vertical.Scrollbar.uparrow", TTK_PACK_TOP)
+	TTK_NODE("Vertical.Scrollbar.downarrow", TTK_PACK_BOTTOM)
+	TTK_NODE(
+	    "Vertical.Scrollbar.thumb", TTK_PACK_TOP|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScrollbarLayout)
+    TTK_GROUP("Horizontal.Scrollbar.trough", TTK_FILL_X,
+	TTK_NODE("Horizontal.Scrollbar.leftarrow", TTK_PACK_LEFT)
+	TTK_NODE("Horizontal.Scrollbar.rightarrow", TTK_PACK_RIGHT)
+	TTK_NODE(
+	"Horizontal.Scrollbar.thumb", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+void TtkScrollbar_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme,"Vertical.TScrollbar",VerticalScrollbarLayout);
+    Ttk_RegisterLayout(theme,"Horizontal.TScrollbar",HorizontalScrollbarLayout);
+
+    RegisterWidget(interp, "ttk::scrollbar", &ScrollbarWidgetSpec);
+}
+
+/*EOF*/