home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xaw / list.d < prev    next >
Encoding:
Text File  |  1992-10-13  |  1.6 KB  |  61 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (define-widget-type 'list "List.h")
  4.  
  5. (prolog
  6. "
  7. static char **Get_List (x) Object x; {
  8.     register i, n;
  9.     register char *s, **l;
  10.     Declare_C_Strings;
  11.  
  12.     Check_List (x);
  13.     n = Fast_Length (x);
  14.     l = (char **)XtMalloc ((n+1) * sizeof (char *));
  15.     for (i = 0; i < n; i++, x = Cdr (x)) {
  16.     Make_C_String (Car (x), s);
  17.     l[i] = XtNewString (s);
  18.     }
  19.     l[i] = 0;
  20.     Dispose_C_Strings;
  21.     return l;
  22. }")
  23.  
  24. (define-widget-class 'list 'listWidgetClass)
  25.  
  26. (define-callback 'list 'callback #t)
  27.  
  28. (c->scheme 'list-callback
  29. "   XawListReturnStruct *p = (XawListReturnStruct *)x;
  30.     return Cons (Make_String (p->string, strlen (p->string)),
  31.     Make_Fixnum (p->list_index));")
  32.  
  33. (scheme->c 'list-list
  34. "   return (XtArgVal)Get_List (x);")
  35.  
  36. (define-primitive 'list-change! '(w x resize)
  37. "   Check_Widget_Class (w, listWidgetClass);
  38.     Check_Type (resize, T_Boolean);
  39.     XawListChange (WIDGET(w)->widget, Get_List (x), 0, 0, EQ (resize, True));
  40.     return Void;")
  41.  
  42. (define-primitive 'list-highlight '(w i)
  43. "   Check_Widget_Class (w, listWidgetClass);
  44.     XawListHighlight (WIDGET(w)->widget, Get_Integer (i));
  45.     return Void;")
  46.  
  47. (define-primitive 'list-unhighlight '(w)
  48. "   Check_Widget_Class (w, listWidgetClass);
  49.     XawListUnhighlight (WIDGET(w)->widget);
  50.     return Void;")
  51.  
  52. (define-primitive 'list-current '(w)
  53. "   XawListReturnStruct *p;
  54.  
  55.     Check_Widget_Class (w, listWidgetClass);
  56.     p = XawListShowCurrent (WIDGET(w)->widget);
  57.     if (p->list_index == XAW_LIST_NONE)
  58.     return False;
  59.     return Cons (Make_String (p->string, strlen (p->string)),
  60.     Make_Fixnum (p->list_index));")
  61.