Changed scrollbar support code so that it can work

with tcl and perl-tk.

1 files changed, 72 insertions, 11 deletions

diff --git a/generic/tkZinc.c b/generic/tkZinc.c
index 3eecd3d..73ed985 100644
--- a/generic/tkZinc.c
+++ b/generic/tkZinc.c
@@ -220,8 +220,13 @@ static Tk_ConfigSpec config_specs[] = {
    "0", Tk_Offset(ZnWInfo, render), 0, NULL},
   {TK_CONFIG_BOOLEAN, "-reshape", "reshape", "Reshape",
    "1", Tk_Offset(ZnWInfo, reshape), 0, NULL},  
+#ifdef PTK
+  {TK_CONFIG_LANGARG, "-scrollregion", "scrollRegion", "ScrollRegion",
+   "", Tk_Offset(ZnWInfo, region), TK_CONFIG_NULL_OK, NULL},
+#else
   {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
    "", Tk_Offset(ZnWInfo, region), TK_CONFIG_NULL_OK, NULL},
+#endif
   {TK_CONFIG_CUSTOM, "-selectbackground", "selectBackground", "Foreground",
    "#a0a0a0", Tk_Offset(ZnWInfo, text_info.sel_color), 0, &gradientOption},
   {TK_CONFIG_DOUBLE, "-speedvectorlength", "speedVectorLength",
@@ -238,12 +243,22 @@ static Tk_ConfigSpec config_specs[] = {
    "AtcSymbol15", Tk_Offset(ZnWInfo, track_symbol), TK_CONFIG_NULL_OK, &bitmapOption},
   {TK_CONFIG_PIXELS, "-width", "width", "Width",
    "10c", Tk_Offset(ZnWInfo, opt_width), 0, NULL},
+#ifdef PTK
+  {TK_CONFIG_CALLBACK, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+   "", Tk_Offset(ZnWInfo, x_scroll_cmd), TK_CONFIG_NULL_OK, NULL},
+#else
   {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
    "", Tk_Offset(ZnWInfo, x_scroll_cmd), TK_CONFIG_NULL_OK, NULL},
+#endif
   {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement", "ScrollIncrement",
    "0", Tk_Offset(ZnWInfo, x_scroll_incr), 0, NULL},
+#ifdef PTK
+  {TK_CONFIG_CALLBACK, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+   "", Tk_Offset(ZnWInfo, y_scroll_cmd), TK_CONFIG_NULL_OK, NULL},
+#else
   {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
    "", Tk_Offset(ZnWInfo, y_scroll_cmd), TK_CONFIG_NULL_OK, NULL},
+#endif
   {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",  "ScrollIncrement",
    "0", Tk_Offset(ZnWInfo, y_scroll_incr), 0, NULL},
   /*
@@ -2255,11 +2270,21 @@ SetOrigin(ZnWInfo	*wi,
  *
  *----------------------------------------------------------------------
  */
+#ifdef PTK
+static void
+ScrollFractions(ZnReal	view1,	/* Lowest coordinate visible in the window. */
+		ZnReal	view2,	/* Highest coordinate visible in the window. */
+		ZnReal	region1,/* Lowest coordinate in the object. */
+		ZnReal	region2,/* Highest coordinate in the object. */
+		ZnReal	*first,
+		ZnReal	*last)
+#else
 static Tcl_Obj *
 ScrollFractions(ZnReal	view1,	/* Lowest coordinate visible in the window. */
 		ZnReal	view2,	/* Highest coordinate visible in the window. */
 		ZnReal	region1,/* Lowest coordinate in the object. */
 		ZnReal	region2)/* Highest coordinate in the object. */
+#endif
 {
   ZnReal range, f1, f2;
   char   buffer[2*TCL_DOUBLE_SPACE+2];
@@ -2282,8 +2307,13 @@ ScrollFractions(ZnReal	view1,	/* Lowest coordinate visible in the window. */
       f2 = f1;
     }
   }
+#ifdef PTK
+  *first = f1;
+  *last = f2;
+#else
   sprintf(buffer, "%g %g", f1, f2);
   return Tcl_NewStringObj(buffer, -1);
+#endif
 }
 
 
@@ -2314,7 +2344,11 @@ UpdateScrollbars(ZnWInfo	*wi)
   Tcl_Interp	*interp;
   int		x_origin, y_origin, width, height;
   int		scroll_xo, scroll_xc, scroll_yo, scroll_yc;
+#ifdef PTK
+  LangCallback  *x_scroll_cmd, *y_scroll_cmd;
+#else
   char		*x_scroll_cmd, *y_scroll_cmd;
+#endif
   Tcl_Obj	*fractions;
 
   /*
@@ -2341,11 +2375,12 @@ UpdateScrollbars(ZnWInfo	*wi)
   scroll_yc = wi->scroll_yc;
   CLEAR(wi->flags, ZN_UPDATE_SCROLLBARS);
   if (wi->x_scroll_cmd != NULL) {
-    fractions = ScrollFractions(x_origin, x_origin + width, scroll_xo, scroll_xc);
 #ifdef PTK
-    /* Need some more work */
-    result = LangDoCallback(interp, x_scroll_cmd, 0, 1, " %L", fractions);
+    ZnReal first, last;
+    ScrollFractions(x_origin, x_origin + width, scroll_xo, scroll_xc, &first, &last);
+    result = LangDoCallback(interp, x_scroll_cmd, 0, 2, " %g %g", first, last);
 #else
+    fractions = ScrollFractions(x_origin, x_origin + width, scroll_xo, scroll_xc);
     result = Tcl_VarEval(interp, x_scroll_cmd, " ", Tcl_GetString(fractions), NULL);
 #endif
     Tcl_DecrRefCount(fractions);
@@ -2357,11 +2392,12 @@ UpdateScrollbars(ZnWInfo	*wi)
   }
   
   if (y_scroll_cmd != NULL) {
-    fractions = ScrollFractions(y_origin, y_origin + height, scroll_yo, scroll_yc);
 #ifdef PTK
-    /* Need some more work */
-    result = LangDoCallback(interp, y_scroll_cmd, 0, 1, " %L", fractions);
+    ZnReal	first, last;
+    ScrollFractions(y_origin, y_origin + height, scroll_yo, scroll_yc, &first, &last);
+    result = LangDoCallback(interp, y_scroll_cmd, 0, 1, " %g %g", fractions);
 #else
+    fractions = ScrollFractions(y_origin, y_origin + height, scroll_yo, scroll_yc);
     result = Tcl_VarEval(interp, y_scroll_cmd, " ", Tcl_GetString(fractions), NULL);
 #endif
     Tcl_DecrRefCount(fractions);
@@ -5356,9 +5392,16 @@ WidgetObjCmd(ClientData		client_data,	/* Information about the widget. */
       ZnReal	new_x=0.0, fraction;
       
       if (argc == 2) {
+#ifdef PTK
+	ZnReal	first, last;
+	ScrollFractions(wi->origin.x, wi->origin.x + Tk_Width(wi->win),
+			wi->scroll_xo, wi->scroll_xc, &first, &last);
+	Tcl_DoubleResults(interp, 2, 0, first, last);
+#else
 	Tcl_SetObjResult(interp,
 			 ScrollFractions(wi->origin.x, wi->origin.x + Tk_Width(wi->win),
 					 wi->scroll_xo, wi->scroll_xc));
+#endif
       }
       else {
 	type = Tk_GetScrollInfoObj(interp, argc, args, &fraction, &count);
@@ -5393,9 +5436,16 @@ WidgetObjCmd(ClientData		client_data,	/* Information about the widget. */
       ZnReal	new_y = 0.0, fraction;
 
       if (argc == 2) {
+#ifdef PTK
+	ZnReal	first, last;
+	ScrollFractions(wi->origin.y, wi->origin.y + Tk_Height(wi->win),
+			wi->scroll_yo, wi->scroll_yc, &first, &last);
+	Tcl_DoubleResults(interp, 2, 0, first, last);
+#else
 	Tcl_SetObjResult(interp,
 			 ScrollFractions(wi->origin.y, wi->origin.y + Tk_Height(wi->win),
 					 wi->scroll_yo, wi->scroll_yc));
+#endif
       }
       else {
 	type = Tk_GetScrollInfoObj(interp, argc, args, &fraction, &count);
@@ -5614,30 +5664,41 @@ Configure(Tcl_Interp		*interp,/* Used for error reporting. */
     if (wi->region != NULL) {
       int	 argc2;
 #ifdef PTK
-      char	**args2;
+      Arg	*args2;
 #else
       CONST char **args2;
 #endif
-      
+
+#ifdef PTK
+      if (Tcl_ListObjGetElements(interp, wi->region, &argc2, &args2) != TCL_OK) {
+#else
       if (Tcl_SplitList(interp, wi->region, &argc2, &args2) != TCL_OK) {
+#endif
 	return TCL_ERROR;
       }
       if (argc2 != 4) {
-	Tcl_AppendResult(interp, "bad scrollRegion \"",
-			 wi->region, "\"", (char *) NULL);
+	Tcl_AppendResult(interp, "bad scrollRegion \"", wi->region, "\"", (char *) NULL);
       badRegion:
+#ifndef PTK
 	ZnFree(wi->region);
 	ZnFree(args2);
+#endif
 	wi->region = NULL;
 	return TCL_ERROR;
       }
+#ifdef PTK
+      if ((Tk_GetPixels(interp, wi->win, LangString(args2[0]), &wi->scroll_xo) != TCL_OK) ||
+	  (Tk_GetPixels(interp, wi->win, LangString(args2[1]), &wi->scroll_yo) != TCL_OK) ||
+	  (Tk_GetPixels(interp, wi->win, LangString(args2[2]), &wi->scroll_xc) != TCL_OK) ||
+	  (Tk_GetPixels(interp, wi->win, LangString(args2[3]), &wi->scroll_yc) != TCL_OK)) {
+#else
       if ((Tk_GetPixels(interp, wi->win, args2[0], &wi->scroll_xo) != TCL_OK) ||
 	  (Tk_GetPixels(interp, wi->win, args2[1], &wi->scroll_yo) != TCL_OK) ||
 	  (Tk_GetPixels(interp, wi->win, args2[2], &wi->scroll_xc) != TCL_OK) ||
 	  (Tk_GetPixels(interp, wi->win, args2[3], &wi->scroll_yc) != TCL_OK)) {
+#endif
 	goto badRegion;
       }
-      ZnFree(args2);
     }
   }