home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxtk12.zip / extensions / rexxtknotebook.c < prev    next >
Text File  |  2002-08-07  |  22KB  |  606 lines
  1. /*
  2.  *  Rexx/Tk - Resizeable Notebook Widget
  3.  *  Copyright (C) 2001  Mark Hessling  <M.Hessling@qut.edu.au>
  4.  *
  5.  *  This library is free software; you can redistribute it and/or
  6.  *  modify it under the terms of the GNU Library General Public
  7.  *  License as published by the Free Software Foundation; either
  8.  *  version 2 of the License, or (at your option) any later version.
  9.  *
  10.  *  This library is distributed in the hope that it will be useful,
  11.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.  *  Library General Public License for more details.
  14.  *
  15.  *  You should have received a copy of the GNU Library General Public
  16.  *  License along with this library; if not, write to the Free
  17.  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  */
  19.  
  20.  
  21. #include "rexxtk.h"
  22.  
  23. char *RxPackageName = "rexxtknotebook";
  24. char *ExtensionSource =
  25. "# A Resizable Notebook widget for Tcl/Tk\n"
  26. "# $Revision: 1.4 $\n"
  27. "#\n"
  28. "# Copyright (C) 1999 Daniel Roche\n"
  29. "#\n"
  30. "# This library is free software; you can redistribute it and/or\n"
  31. "# modify it under the terms of the GNU Library General Public\n"
  32. "# License as published by the Free Software Foundation; either\n"
  33. "# version 2 of the License, or (at your option) any later version.\n"
  34. "#\n"
  35. "# This library is distributed in the hope that it will be useful,\n"
  36. "# but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
  37. "# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n"
  38. "# Library General Public License for more details.\n"
  39. "# \n"
  40. "# You should have received a copy of the GNU Library General Public\n"
  41. "# License along with this library; if not, write to the\n"
  42. "# Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n"
  43. "# Boston, MA  02111-1307, USA.\n"
  44. "#\n"
  45. "# Author contact information:\n"
  46. "#   daniel.roche@bigfoot.com\n"
  47. "#   http://www.multimania.com/droche/\n"
  48. "#\n"
  49. "# Thanks to Earl Roosa <earl.roosa@db.com> for the addtab patch\n"
  50. "#\n"
  51. "#########################################################\n"
  52. "# \n"
  53. "# Rnotebook:create new_widget_name [option value ...]\n"
  54. "#  where options are :\n"
  55. "#   [-borderwidth i]      set the borderwidth of the tabs and the frame\n"
  56. "#   [-height i]           set the height of the tabs in pixel\n"
  57. "#   [-tabs tablist]       set the tabs according to each element of the list\n"
  58. "#   [-nbtab i]            set the tabs number, by default the tabs are named \n"
  59. "#                         according to their position number\n"
  60. "#   [-padx i]             set the space between each tabs in pixel\n"
  61. "#   [-background col]     set the background color for the tabs and the frame\n"
  62. "#   [-foreground col]     set the background color for the tabs\n"
  63. "#   [-command cmd]        command to run when tab is raised\n"
  64. "#\n"
  65. "# Rnotebook:config widget_name [option value ...]\n"
  66. "#  where options are :\n"
  67. "#   [-borderwidth i]      set the borderwidth of the tabs and the frame\n"
  68. "#   [-height i]           set the height of the tabs in pixel\n"
  69. "#   [-padx i]             set the space between each tabs in pixel\n"
  70. "#   [-background col]     set the background color for the tabs and the frame\n"
  71. "#   [-foreground col]     set the background color for the tabs\n"
  72. "#   [-tabs tablist]       set the tabs according to each element of the list\n"
  73. "#   [-nbtab i]            set the tabs number, by default the tabs are named \n"
  74. "#                         according to their position number\n"
  75. "#   [-command cmd]        command to run when tab is raised\n"
  76. "#\n"
  77. "# Rnotebook:raise widget_name page_number\n"
  78. "#  raise the specified page number of the specified notebook\n"
  79. "#\n"
  80. "# Rnotebook:frame widget_name page_number\n"
  81. "#  return the frame widget associated with the specified page number\n"
  82. "#  it is a real tcl 'frame' widget and thus can be configured as any other frame.\n"
  83. "#\n"
  84. "# Rnotebook:button widget_name page_number\n"
  85. "#  return the button widget associated with the specified page number\n"
  86. "#  it is a real tcl 'button' widget and thus can be configured as any other button.\n"
  87. "#\n"
  88. "#########################################################\n"
  89. "\n"
  90. "\n"
  91. "#\n"
  92. "# Create a new notebook widget\n"
  93. "#\n"
  94. "proc Rnotebook:create {w args} {\n"
  95. "    global Rnotebook tcl_platform\n"
  96. "    # create/init base widget\n"
  97. "    frame $w -borderwidth 0 -relief flat\n"
  98. "    # init default data structure\n"
  99. "    set Rnotebook($w,nbtab) 1\n"
  100. "    set Rnotebook($w,tabs) {1}\n"
  101. "    set Rnotebook($w,current) 0\n"
  102. "    set Rnotebook($w,theight) 30\n"
  103. "    set Rnotebook($w,padx) 0\n"
  104. "    set Rnotebook($w,bwidth) 2\n"
  105. "    set Rnotebook($w,background) [$w cget -background]\n"
  106. "    set Rnotebook($w,foreground) black\n"
  107. "    set Rnotebook($w,command) {}\n"
  108. "    # parse arguments\n"
  109. "    foreach {tag value} $args {\n"
  110. "   switch -- $tag {\n"
  111. "       -borderwidth {\n"
  112. "      set Rnotebook($w,bwidth) $value\n"
  113. "       }\n"
  114. "       -height {\n"
  115. "      set Rnotebook($w,theight) $value\n"
  116. "       }\n"
  117. "       -tabs {\n"
  118. "      set Rnotebook($w,tabs) $value\n"
  119. "      set Rnotebook($w,nbtab) [llength $value]\n"
  120. "       }\n"
  121. "       -nbtab {\n"
  122. "      set Rnotebook($w,nbtab) $value\n"
  123. "       }\n"
  124. "       -padx {\n"
  125. "      set Rnotebook($w,padx) $value\n"
  126. "       }\n"
  127. "       -background {\n"
  128. "      set Rnotebook($w,background) $value\n"
  129. "       }\n"
  130. "       -foreground {\n"
  131. "      set Rnotebook($w,foreground) $value\n"
  132. "       }\n"
  133. "       -command {\n"
  134. "      set Rnotebook($w,command) $value\n"
  135. "       }\n"
  136. "   }\n"
  137. "    }\n"
  138. "    # build associated widgets\n"
  139. "    frame $w.tabs -borderwidth 0 -relief flat\n"
  140. "       #-background $Rnotebook($w,background)\n"
  141. "    frame $w.body -borderwidth $Rnotebook($w,bwidth) -relief raised -background $Rnotebook($w,background)\n"
  142. "    frame $w.mask -borderwidth 0 -relief flat -background $Rnotebook($w,background)\n"
  143. "    frame $w.mskl -borderwidth 0 -relief flat -background $Rnotebook($w,background)\n"
  144. "    if [string compare $tcl_platform(platform) windows] {\n"
  145. "   # Unix look :-)\n"
  146. "   frame $w.mskl.ml -borderwidth $Rnotebook($w,bwidth) -relief sunken\n"
  147. "   place $w.mskl.ml -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 3 * $Rnotebook($w,bwidth)]\n"
  148. "    } else {\n"
  149. "   # losedoze look :-(\n"
  150. "   frame $w.mskl.ml -borderwidth $Rnotebook($w,bwidth) -relief raised\n"
  151. "   place $w.mskl.ml -x 0 -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 4 * $Rnotebook($w,bwidth)]\n"
  152. "    }\n"
  153. "    frame $w.mskr -borderwidth 0 -relief flat -background $Rnotebook($w,background)\n"
  154. "    if [string compare $tcl_platform(platform) windows] {\n"
  155. "   # Unix look :-)\n"
  156. "   frame $w.mskr.mr -borderwidth $Rnotebook($w,bwidth) -relief sunken\n"
  157. "   place $w.mskr.mr -x 0 -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 3 * $Rnotebook($w,bwidth)]\n"
  158. "    } else {\n"
  159. "   # losedoze look :-(\n"
  160. "   frame $w.mskr.mr -borderwidth $Rnotebook($w,bwidth) -relief raised\n"
  161. "   place $w.mskr.mr -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 4 * $Rnotebook($w,bwidth)]\n"
  162. "    }\n"
  163. "    place $w.tabs -x 0 -y 0 -relwidth 1.0 -height $Rnotebook($w,theight)\n"
  164. "    place $w.body -x 0 -y $Rnotebook($w,theight) -relwidth 1.0 -relheight 1.0 -height -$Rnotebook($w,theight)\n"
  165. "    for {set ind 1} {$ind <= $Rnotebook($w,nbtab)} {incr ind} {\n"
  166. "        Rnotebook:addtab $w $ind\n"
  167. "    }\n"
  168. "    # show page 1\n"
  169. "    eval Rnotebook:raise $w 1\n"
  170. "    return $w\n"
  171. "}\n"
  172. "\n"
  173. "proc Rnotebook:addtab {w ind} {\n"
  174. "    global Rnotebook\n"
  175. "    set i2 [expr $ind - 1]\n"
  176. "    set txt [lindex $Rnotebook($w,tabs) $i2]\n"
  177. "    if {! [string length $txt] } {\n"
  178. "        set txt $ind\n"
  179. "    }\n"
  180. "    button $w.tabs.b$ind -text $txt -borderwidth $Rnotebook($w,bwidth) -background $Rnotebook($w,background) -foreground $Rnotebook($w,foreground) -command \"Rnotebook:raise $w $ind\"\n"
  181. "    pack $w.tabs.b$ind -side left -pady 0 -padx $Rnotebook($w,padx) -fill y\n"
  182. "    bind $w.tabs.b$ind <Configure> \"Rnotebook:raise $w current\"\n"
  183. "    frame $w.body.f$ind -borderwidth 0 -background $Rnotebook($w,background)\n"
  184. "\n"
  185. "}\n"
  186. "\n"
  187. "#\n"
  188. "# Change configuration options for the notebook widget\n"
  189. "#\n"
  190. "proc Rnotebook:config {w args} {\n"
  191. "  global Rnotebook tcl_platform\n"
  192. "  set nbt $Rnotebook($w,nbtab)\n"
  193. "  foreach {tag value} $args {\n"
  194. "    switch -- $tag {\n"
  195. "      -borderwidth {\n"
  196. "       set Rnotebook($w,bwidth) $value\n"
  197. "       $w.body configure -borderwidth $Rnotebook($w,bwidth)\n"
  198. "       $w.mskl.ml configure -borderwidth $Rnotebook($w,bwidth)\n"
  199. "       $w.mskr.mr configure -borderwidth $Rnotebook($w,bwidth)\n"
  200. "       set lst [winfo children $w.tabs]\n"
  201. "       foreach wid $lst {\n"
  202. "         $wid configure -borderwidth $Rnotebook($w,bwidth)\n"
  203. "       }\n"
  204. "       if [string compare $tcl_platform(platform) windows] {\n"
  205. "         # Unix look :-)\n"
  206. "         place $w.mskl.ml -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 3 * $Rnotebook($w,bwidth)]\n"
  207. "       } else {\n"
  208. "         # losedoze look :-(\n"
  209. "         place $w.mskl.ml -x 0 -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 4 * $Rnotebook($w,bwidth)]\n"
  210. "       }\n"
  211. "       if [string compare $tcl_platform(platform) windows] {\n"
  212. "         # Unix look :-)\n"
  213. "         place $w.mskr.mr -x 0 -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 3 * $Rnotebook($w,bwidth)]\n"
  214. "       } else {\n"
  215. "         # losedoze look :-(\n"
  216. "         place $w.mskr.mr -x -$Rnotebook($w,bwidth) -y -$Rnotebook($w,bwidth) -width [expr 2 * $Rnotebook($w,bwidth)] -height [expr 4 * $Rnotebook($w,bwidth)]\n"
  217. "       }\n"
  218. "     }\n"
  219. "     -background {\n"
  220. "      set Rnotebook($w,background) $value\n"
  221. "      $w.body configure -background $Rnotebook($w,background)\n"
  222. "      $w.mskl.ml configure -background $Rnotebook($w,background)\n"
  223. "      $w.mskr.mr configure -background $Rnotebook($w,background)\n"
  224. "      set lst [winfo children $w.tabs]\n"
  225. "      foreach wid $lst {\n"
  226. "        $wid configure -background $Rnotebook($w,background)\n"
  227. "      }\n"
  228. "      $w.mask configure -background $Rnotebook($w,background)\n"
  229. "     }\n"
  230. "     -foreground {\n"
  231. "      set Rnotebook($w,foreground) $value\n"
  232. "      set lst [winfo children $w.tabs]\n"
  233. "      foreach wid $lst {\n"
  234. "        $wid configure -foreground $Rnotebook($w,foreground)\n"
  235. "      }\n"
  236. "     }\n"
  237. "     -height {\n"
  238. "      set Rnotebook($w,theight) $value\n"
  239. "      place $w.tabs -x 0 -y 0 -relwidth 1.0 -height $Rnotebook($w,theight)\n"
  240. "      place $w.body -x 0 -y $Rnotebook($w,theight) -relwidth 1.0 -relheight 1.0 -height -$Rnotebook($w,theight)\n"
  241. "     }\n"
  242. "     -padx {\n"
  243. "      set Rnotebook($w,padx) $value\n"
  244. "      set lst [winfo children $w.tabs]\n"
  245. "      foreach wid $lst {\n"
  246. "        pack $wid -padx $Rnotebook($w,padx)\n"
  247. "      }\n"
  248. "     }\n"
  249. "     -tabs {\n"
  250. "      set Rnotebook($w,tabs) $value\n"
  251. "      set Rnotebook($w,nbtab) [llength $value]\n"
  252. "     }\n"
  253. "     -nbtab {\n"
  254. "      set Rnotebook($w,nbtab) $value\n"
  255. "     }\n"
  256. "     -command {\n"
  257. "      set Rnotebook($w,command) $value\n"
  258. "     }\n"
  259. "    }\n"
  260. "  }\n"
  261. "  if {$nbt < $Rnotebook($w,nbtab)} {\n"
  262. "    for {set ind [expr $nbt+1]} {$ind <= $Rnotebook($w,nbtab)} {incr ind} {\n"
  263. "      Rnotebook:addtab $w $ind\n"
  264. "    }\n"
  265. "  }\n"
  266. "}\n"
  267. "\n"
  268. "#\n"
  269. "# This procedure raises a notebook page given its number.\n"
  270. "# first page is number 1\n"
  271. "#\n"
  272. "proc Rnotebook:raise {w num} {\n"
  273. "  global Rnotebook\n"
  274. "  if { ![string compare $num \"current\"] } {\n"
  275. "    set num $Rnotebook($w,current)\n"
  276. "  }\n"
  277. "  if { $num == 0 } {\n"
  278. "    set num 1\n"
  279. "  }\n"
  280. "  if { $num != $Rnotebook($w,current) } {\n"
  281. "    pack forget $w.body.f$Rnotebook($w,current)\n"
  282. "    pack $w.body.f$num -fill both -expand 1\n"
  283. "  }\n"
  284. "  set Rnotebook($w,current) $num\n"
  285. "  set bw $Rnotebook($w,bwidth)\n"
  286. "\n"
  287. "  set x0 [expr [winfo x $w.tabs.b$num] + [winfo x $w.tabs] + $bw ]\n"
  288. "  set y0 [expr [winfo y $w.tabs.b$num] + [winfo y $w.tabs] + [winfo height $w.tabs.b$num] - $bw]\n"
  289. "  set w0 [expr [winfo width $w.tabs.b$num] - ($bw * 2)] \n"
  290. "  set h0 [expr $bw * 2]\n"
  291. "  place $w.mask -x $x0 -y $y0 -width $w0 -height $h0\n"
  292. "\n"
  293. "  set x1 [expr $x0 - $bw]\n"
  294. "  set y1 $y0\n"
  295. "  set w1 $bw\n"
  296. "  set h1 $h0\n"
  297. "  place $w.mskl -x $x1 -y $y1 -width $w1 -height $h1\n"
  298. "  \n"
  299. "  set x2 [expr $x0 + $w0]\n"
  300. "  set y2 $y0\n"
  301. "  set w2 $bw\n"
  302. "  set h2 $h0\n"
  303. "  place $w.mskr -x $x2 -y $y2 -width $w2 -height $h2\n"
  304. "  if { [string length $Rnotebook($w,command)] > 0} {\n"
  305. "    eval $Rnotebook($w,command) $num\n"
  306. "  }\n"
  307. "}\n"
  308. "\n"
  309. "#\n"
  310. "# Return the frame associated with a given page number\n"
  311. "#\n"
  312. "proc Rnotebook:frame {w num} {\n"
  313. "  global Rnotebook\n"
  314. "  set i \"$w.body.f$num\"\n"
  315. "  if [ winfo exists $i] {\n"
  316. "    return $i\n"
  317. "  } else {\n"
  318. "    return {}\n"
  319. "  }\n"
  320. "}\n"
  321. "\n"
  322. "#\n"
  323. "# Return the button associated with a given page number\n"
  324. "#\n"
  325. "proc Rnotebook:button {w num} {\n"
  326. "  global Rnotebook\n"
  327. "  set i \"$w.tabs.b$num\"\n"
  328. "  if [ winfo exists $i] {\n"
  329. "    return $i\n"
  330. "  } else {\n"
  331. "    return {}\n"
  332. "  }\n"
  333. "}\n";
  334.  
  335. RexxFunctionHandler TkNotebookLoadFuncs    ;
  336. RexxFunctionHandler TkNotebookDropFuncs    ;
  337. RexxFunctionHandler TkNotebook  ;
  338. RexxFunctionHandler TkNotebookAddTab  ;
  339. RexxFunctionHandler TkNotebookButton  ;
  340. RexxFunctionHandler TkNotebookConfig  ;
  341. RexxFunctionHandler TkNotebookFrame  ;
  342. RexxFunctionHandler TkNotebookRaise  ;
  343.  
  344. /*-----------------------------------------------------------------------------
  345.  * Table of TK Functions. Used to install/de-install functions.
  346.  * If you change this table, don't forget to change the table at the end
  347.  * of this file.
  348.  *----------------------------------------------------------------------------*/
  349. RexxFunction RxPackageFunctions[] = {
  350.    { "TKNOTEBOOKDROPFUNCS"       ,TkNotebookDropFuncs       ,"TkNotebookDropFuncs"       , 1 },
  351.    { "TKNOTEBOOKLOADFUNCS"       ,TkNotebookLoadFuncs       ,"TkNotebookLoadFuncs"       , 0 }, /* don't load this from a DLL */
  352.    { "TKNOTEBOOK"                ,TkNotebook                ,"TkNotebook"                , 1 },
  353.    { "TKNOTEBOOKADDTAB"          ,TkNotebookAddTab          ,"TkNotebookAddTab"          , 1 },
  354.    { "TKNOTEBOOKBUTTON"          ,TkNotebookButton          ,"TkNotebookButton"          , 1 },
  355.    { "TKNOTEBOOKCONFIG"          ,TkNotebookConfig          ,"TkNotebookConfig"          , 1 },
  356.    { "TKNOTEBOOKFRAME"           ,TkNotebookFrame           ,"TkNotebookFrame"           , 1 },
  357.    { "TKNOTEBOOKRAISE"           ,TkNotebookRaise           ,"TkNotebookRaise"           , 1 },
  358.    { NULL, NULL, NULL, 0 }
  359. };
  360.  
  361. static char czTclCommand[TCLCOMMANDLEN];
  362. static REXXTKDATA *RexxTkData;
  363.    
  364. #if defined(WIN32) || defined(OS2_DYN)
  365. Tcl_Interp *RexxTk_TclCreateInterp(void)
  366. {
  367.    return RexxTkData->Dyn_TclCreateInterp();
  368. }
  369.  
  370. int RexxTk_TclEval(Tcl_Interp *interp, char *string)
  371. {
  372.    return RexxTkData->Dyn_TclEval( interp, string );
  373. }
  374.  
  375. int RexxTk_TclInit(Tcl_Interp *interp)
  376. {
  377.    return RexxTkData->Dyn_TclInit( interp );
  378. }
  379.  
  380. int RexxTk_TkInit(Tcl_Interp *interp)
  381. {
  382.    return RexxTkData->Dyn_TkInit( interp );
  383. }
  384. #endif
  385.  
  386. /*
  387.  * Rexx/Tk notebook functions start here...
  388.  */
  389.  
  390. /*
  391.  * Rnotebook:create pathName ?options?
  392.  * TkNotebook(pathName [,options])
  393.  */
  394. RFH_RETURN_TYPE TkNotebook
  395.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  396. {
  397.    FunctionPrologue( (char *)name, argc, argv );
  398.  
  399.    return rtk_TypeA(RexxTkData,czTclCommand,name,"Rnotebook:create", argc, argv, retstr);
  400. }
  401.  
  402. /*
  403.  * Rnotebook:addtab pathName index
  404.  * TkNotebookAddTab(pathName, index)
  405.  */
  406. RFH_RETURN_TYPE TkNotebookAddTab
  407.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  408. {
  409.    FunctionPrologue( (char *)name, argc, argv );
  410.  
  411.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  412.  
  413.    if ( my_checkparam( name, argc, 2, 2 ) )
  414.       return 1;
  415.  
  416.    return rtk_TypeB(RexxTkData,czTclCommand,name,"Rnotebook:addtab", argc, argv, retstr);
  417. }
  418.  
  419. /*
  420.  * Rnotebook:button pathName index
  421.  * TkNotebookButton(pathName, index)
  422.  */
  423. RFH_RETURN_TYPE TkNotebookButton
  424.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  425. {
  426.    FunctionPrologue( (char *)name, argc, argv );
  427.  
  428.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  429.  
  430.    if ( my_checkparam( name, argc, 2, 2 ) )
  431.       return 1;
  432.  
  433.    return rtk_TypeB(RexxTkData,czTclCommand,name,"Rnotebook:button", argc, argv, retstr);
  434. }
  435.  
  436. /*
  437.  * Rnotebook:frame pathName index
  438.  * TkNotebookFrame(pathName, index)
  439.  */
  440. RFH_RETURN_TYPE TkNotebookFrame
  441.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  442. {
  443.    FunctionPrologue( (char *)name, argc, argv );
  444.  
  445.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  446.  
  447.    if ( my_checkparam( name, argc, 2, 2 ) )
  448.       return 1;
  449.  
  450.    return rtk_TypeB(RexxTkData,czTclCommand,name,"Rnotebook:frame", argc, argv, retstr);
  451. }
  452.  
  453. /*
  454.  * Rnotebook:raise pathName index
  455.  * TkNotebookRaise(pathName, index)
  456.  */
  457. RFH_RETURN_TYPE TkNotebookRaise
  458.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  459. {
  460.    FunctionPrologue( (char *)name, argc, argv );
  461.  
  462.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  463.  
  464.    if ( my_checkparam( name, argc, 2, 2 ) )
  465.       return 1;
  466.  
  467.    return rtk_TypeB(RexxTkData,czTclCommand,name,"Rnotebook:raise", argc, argv, retstr);
  468. }
  469.  
  470. /*
  471.  * Rnotebook:config pathName ?options?
  472.  * TkNotebookConfig(pathName [,options])
  473.  */
  474. RFH_RETURN_TYPE TkNotebookConfig
  475.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  476. {
  477.    FunctionPrologue( (char *)name, argc, argv );
  478.  
  479.    if (RexxTkData->REXXTK_IntCode) ClearIntError( RexxTkData);
  480.  
  481.    if ( my_checkparam( name, argc, 1, 0 ) )
  482.       return 1;
  483.  
  484.    return rtk_TypeC(RexxTkData,czTclCommand,name,"Rnotebook:config", argc, argv, retstr);
  485. }
  486.  
  487. RFH_RETURN_TYPE TkNotebookDropFuncs
  488.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  489. {
  490.    ULONG rc=0;
  491.    int unload=0;
  492.  
  493.    if ( my_checkparam(name, argc, 0, 1 ) )
  494.       return( 1 );
  495.    if ( argv[0].strlength == 6
  496.    &&   memcmpi( argv[0].strptr, "UNLOAD", 6 ) == 0 )
  497.       unload = 1;
  498.    (void)TermRxPackage( RxPackageName, unload );
  499.    return RxReturnNumber( retstr, rc );
  500. }
  501.  
  502.  
  503. RFH_RETURN_TYPE TkNotebookLoadFuncs
  504.    (RFH_ARG0_TYPE name, RFH_ARG1_TYPE argc, RFH_ARG2_TYPE argv, RFH_ARG3_TYPE stck, RFH_ARG4_TYPE retstr)
  505. {
  506.    ULONG rc = 0L;
  507.  
  508. #if defined(DYNAMIC_LIBRARY)
  509.    if ( !QueryRxFunction( "TKWAIT" ) )
  510.    {
  511.       fprintf(stderr,"The base Rexx/Tk function package must be loaded before this one\n");
  512.       return RxReturnNumber( retstr, 1 );
  513.    }
  514.    /*
  515.     * get the pointer to the tcl Interpreter and the base data from base Rexx/Tk
  516.     * library
  517.     */
  518.    if ( argc == 0 )
  519.    {
  520.       fprintf(stderr,"You must pass the return value from TkGetBaseData() as the one and only argument.\n");
  521.       return RxReturnNumber( retstr, 1 );
  522.    }
  523.    RexxTkData = (REXXTKDATA *)atol(argv[0].strptr);
  524.    rc = InitRxPackage( NULL );
  525.    /* 
  526.     * Register all external functions
  527.     */
  528.    if ( !rc )
  529.    {
  530.       rc = RegisterRxFunctions( );
  531.    }
  532. #endif
  533.    return RxReturnNumber( retstr, rc );
  534. }
  535.    
  536. /*
  537.  * The following functions are used in rxpackage.c
  538.  */
  539.  
  540. /*-----------------------------------------------------------------------------
  541.  * Execute any initialisation
  542.  *----------------------------------------------------------------------------*/
  543. int InitialisePackage
  544.  
  545. #ifdef HAVE_PROTO
  546.    ( void )
  547. #else
  548.    ( )
  549. #endif
  550.  
  551. {
  552.    InternalTrace( "InitialisePackage", NULL );
  553.  
  554.    /*
  555.     * Install the Tree widget
  556.     */
  557.    if (Tcl_Eval( RexxTkData->RexxTkInterp,ExtensionSource ) !=TCL_OK) {
  558.       fprintf(stderr, "Tk_Eval for Rnotebook widget failed miserably at line %d: %s\n", RexxTkData->RexxTkInterp->errorLine, RexxTkData->RexxTkInterp->result);
  559.       return 1;
  560.    }
  561.    DEBUGDUMP(fprintf(stderr,"%s-%d: After Tcl_Eval()\n",__FILE__,__LINE__);)
  562.    return 0;
  563. }
  564.  
  565. /*-----------------------------------------------------------------------------
  566.  * Execute any termination
  567.  *----------------------------------------------------------------------------*/
  568. int TerminatePackage
  569.  
  570. #ifdef HAVE_PROTO
  571.    ( void )
  572. #else
  573.    ( )
  574. #endif
  575.  
  576. {
  577.    return 0;
  578. }
  579.  
  580.  
  581. #if defined(USE_REXX6000)
  582. /*
  583.  * This function is used as the entry point for the REXX/6000
  584.  * Rexx Interpreter
  585.  * If you change this table, don't forget to change the table at the
  586.  * start of this file.
  587.  */
  588. USHORT InitFunc( RXFUNCBLOCK **FuncBlock )
  589. {
  590.    static RXFUNCBLOCK funcarray[] =
  591.    {
  592.       { "TKNOTEBOOKDROPFUNCS"       ,TkNotebookDropFuncs      ,NULL },
  593.       { "TKNOTEBOOKLOADFUNCS"       ,TkNotebookLoadFuncs      ,NULL },
  594.       { "TKNOTEBOOK"                ,TkNotebook               ,NULL },
  595.       { "TKNOTEBOOKADDTAB"          ,TkNotebookAddTab         ,NULL },
  596.       { "TKNOTEBOOKBUTTON"          ,TkNotebookButton         ,NULL },
  597.       { "TKNOTEBOOKCONFIG"          ,TkNotebookConfig         ,NULL },
  598.       { "TKNOTEBOOKFRAME"           ,TkNotebookFrame          ,NULL },
  599.       { "TKNOTEBOOKRAISE"           ,TkNotebookRaise          ,NULL },
  600.       { NULL, NULL, NULL }
  601.    } ;
  602.    *FuncBlock = funcarray;
  603.    return (USHORT)0;
  604. }
  605. #endif
  606.