home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / tk-util.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-04-26  |  2.2 KB  |  84 lines
  1. /*
  2.  *
  3.  * t k - u t i l . c         - Some Tk utilities 
  4.  *
  5.  *
  6.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  7.  * 
  8.  *
  9.  * Permission to use, copy, and/or distribute this software and its
  10.  * documentation for any purpose and without fee is hereby granted, provided
  11.  * that both the above copyright notice and this permission notice appear in
  12.  * all copies and derived works.  Fees for distribution or use of this
  13.  * software or derived works may only be charged with express written
  14.  * permission of the copyright holder.  
  15.  * This software is provided ``as is'' without express or implied warranty.
  16.  *
  17.  * This software is a derivative work of other copyrighted softwares; the
  18.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  19.  *
  20.  *            Author: Erick Gallesio [eg@unice.fr]
  21.  *    Creation date: 19-Feb-1993 22:15
  22.  * Last file update: 26-Apr-1996 23:17
  23.  *
  24.  */
  25.  
  26. #ifdef USE_TK
  27. #include "stk.h"
  28. #include "tk-glue.h"
  29.  
  30. PRIMITIVE STk_string2widget(SCM str)
  31. {
  32.   SCM tmp, w;
  33.   char *s;
  34.  
  35.   if (NSTRINGP(str)) Err("string->widget: bad string", str);
  36.  
  37.   s = CHARS(str);
  38.   if (strcmp(s, ".") == 0) s = ROOT_WINDOW;
  39.  
  40.   tmp = Intern(s);
  41.   if (STk_symbol_boundp(tmp, STk_globenv) == Truth && TKCOMMP(w=STk_eval(tmp, NIL)))
  42.     return w;
  43.   return Ntruth;
  44. }
  45.  
  46. PRIMITIVE STk_widget2string(SCM widget)
  47. {
  48.   char *tmp;
  49.  
  50.   if (NTKCOMMP(widget)) Err("widget->string: bad widget", widget);
  51.   tmp = (widget == STk_root_window) ? ROOT_WINDOW
  52.                     : widget->storage_as.tk.data->Id;
  53.   return STk_makestring(tmp);
  54. }
  55.  
  56. PRIMITIVE STk_tk_commandp(SCM obj)
  57. {
  58.   return TKCOMMP(obj) ? Truth : Ntruth;
  59. }
  60.  
  61. PRIMITIVE STk_widget_name(SCM widget)
  62. {
  63.   char *tmp;
  64.   
  65.   if (NTKCOMMP(widget)) Err("widget-name: bad widget", widget);
  66.   tmp = (widget == STk_root_window) ? ROOT_WINDOW
  67.                         : widget->storage_as.tk.data->Id;
  68.   return Intern(tmp);
  69. }
  70.  
  71. PRIMITIVE STk_get_widget_data(SCM widget)
  72. {
  73.   if (NTKCOMMP(widget)) Err("get-widget-data: bad widget", widget);
  74.   return widget->storage_as.tk.l_data;
  75. }
  76.  
  77. PRIMITIVE STk_set_widget_data(SCM widget, SCM value)
  78. {
  79.   if (NTKCOMMP(widget)) Err("set-widget-data!: bad widget", widget);
  80.   widget->storage_as.tk.l_data = value;
  81.   return UNDEFINED;
  82. }
  83. #endif /* USE_TK */
  84.