home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / tcl / 2100 < prev    next >
Encoding:
Internet Message Format  |  1992-12-12  |  6.2 KB
  1. Path: sparky!uunet!elroy.jpl.nasa.gov!nntp-server.caltech.edu!nntp-server.caltech.edu!tromey
  2. From: tromey@cns.caltech.edu (Tom Tromey)
  3. Newsgroups: comp.lang.tcl
  4. Subject: Dynamically reconfigurable cascade menus
  5. Date: 12 Dec 92 11:31:22
  6. Organization: California Institute of Technology
  7. Lines: 174
  8. Message-ID: <TROMEY.92Dec12113122@kant.cns.caltech.edu>
  9. NNTP-Posting-Host: kant.cns.caltech.edu
  10.  
  11. Enclosed is a patch to Tk2.3 that implements dynamically
  12. reconfigurable cascade menus.
  13.  
  14. This patch does two things:
  15.  
  16. * Usurps the -command option for cascade menu entries.  The command is
  17. now run from ActivateMenuEnty just before the submenu is popped up.
  18. The command can reconfigure the submenu (within limits; see below)
  19. before it is popped up.  The canonical example is a menu which is
  20. dynamically reconfigured to show the elements of a directory, even if
  21. the contents of the directory change.  Note that the -command option
  22. is no longer available if the cascade menu item itself is activated;
  23. now nothing happens in that case.
  24.  
  25. * Extends the "$menu delete" command (where $menu is a menu of
  26. course).  Now the usage is "$menu delete first ?last?".  This eases
  27. reconfiguration of submenus somewhat.
  28.  
  29. I wanted the code to work so that my -command entry for a cascade item
  30. could delete the submenu and re-create it from scratch, but my first
  31. stab didn't work, and I only have one machine here to work on -- which
  32. makes debugging menu code difficult to impossible.  There are only so
  33. many printfs I can add without going crazy (sometimes I think: if gdb
  34. used Tcl as its scripting language, then I could do things like this
  35. by setting a lot of breakpoints which would automatically print local
  36. variables and continue -- in effect adding printfs without actually
  37. adding them -- but alas, the gdb people aren't quite enlightened
  38. enough, or don't have the time, or whatever).
  39.  
  40. So as it stands, you can delete all the elements of the cascade
  41. submenu, but you can't change the submenu itself (from inside the
  42. -command callback).
  43.  
  44. Here is some sample code to show how dynamic menus work:
  45.  
  46.  
  47. #!/home/isis/tromey/tk2.3/wish -f
  48. # Test of dynamic cascade menus
  49.  
  50. proc RC menu {
  51.   # catch in case the menu is intially empty
  52.   catch {$menu delete 0 last}
  53.   foreach file [glob -nocomplain *] {
  54.     $menu add command -label $file -command "puts stderr $file"
  55.   }
  56.   .mb.menu entryconfigure 0 -menu $menu
  57. }
  58.  
  59. menubutton .mb -text Blah -menu .mb.menu
  60. menu .mb.menu
  61. .mb.menu add cascade -label directory -command "RC .mb.menu.menu" \
  62.   -menu .mb.menu.menu
  63. menu .mb.menu.menu
  64.  
  65. pack append . .mb left
  66.  
  67.  
  68. Tom
  69.  
  70. *** tkMenu.c.~1~    Sat Dec  5 14:09:20 1992
  71. --- tkMenu.c    Mon Dec  7 16:00:01 1992
  72. ***************
  73. *** 601,633 ****
  74.           result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
  75.               TK_CONFIG_ARGV_ONLY);
  76.       }
  77.       } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
  78.           && (length >= 2)) {
  79. !     int index, i;
  80.   
  81. !     if (argc != 3) {
  82.           Tcl_AppendResult(interp, "wrong # args: should be \"",
  83. !             argv[0], " delete index\"", (char *) NULL);
  84.           goto error;
  85.       }
  86. !     if (GetMenuIndex(interp, menuPtr, argv[2], &index) != TCL_OK) {
  87.           goto error;
  88.       }
  89. !     if (index < 0) {
  90.           goto done;
  91.       }
  92. !     Tk_EventuallyFree((ClientData) menuPtr->entries[index],
  93. !         DestroyMenuEntry);
  94. !     for (i = index; i < menuPtr->numEntries-1; i++) {
  95. !         menuPtr->entries[i] = menuPtr->entries[i+1];
  96.       }
  97. !     menuPtr->numEntries -= 1;
  98. !     if (menuPtr->active == index) {
  99.           menuPtr->active = -1;
  100. !     } else if (menuPtr->active > index) {
  101. !         menuPtr->active -= 1;
  102.       }
  103.       if (!(menuPtr->flags & RESIZE_PENDING)) {
  104.           menuPtr->flags |= RESIZE_PENDING;
  105.           Tk_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
  106.       }
  107. --- 601,642 ----
  108.           result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
  109.               TK_CONFIG_ARGV_ONLY);
  110.       }
  111.       } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
  112.           && (length >= 2)) {
  113. !     int first, last, i;
  114.   
  115. !     if (argc != 3 && argc != 4) {
  116.           Tcl_AppendResult(interp, "wrong # args: should be \"",
  117. !             argv[0], " delete first ?last?\"", (char *) NULL);
  118.           goto error;
  119.       }
  120. !     if (GetMenuIndex(interp, menuPtr, argv[2], &first) != TCL_OK) {
  121.           goto error;
  122.       }
  123. !     if (argc == 3) {
  124. !         last = first;
  125. !     } else {
  126. !         if (GetMenuIndex(interp, menuPtr, argv[3], &last) != TCL_OK) {
  127. !             goto error;
  128. !         }
  129. !     }
  130. !     if ((first < 0) || (last < 0) || (last < first)) {
  131.           goto done;
  132.       }
  133. !     for (i = first; i <= last; ++i) {
  134. !         Tk_EventuallyFree((ClientData) menuPtr->entries[i],
  135. !                   DestroyMenuEntry);
  136. !         if (i < menuPtr->numEntries-(last-first+1)) {
  137. !             menuPtr->entries[i] = menuPtr->entries[i+(last-first+1)];
  138. !         }
  139.       }
  140. !     menuPtr->numEntries -= (last-first+1);
  141. !     if ((menuPtr->active >= first) && (menuPtr->active <= last)) {
  142.           menuPtr->active = -1;
  143. !     } else if (menuPtr->active > last) {
  144. !         menuPtr->active -= (last-first+1);
  145.       }
  146.       if (!(menuPtr->flags & RESIZE_PENDING)) {
  147.           menuPtr->flags |= RESIZE_PENDING;
  148.           Tk_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
  149.       }
  150. ***************
  151. *** 2045,2055 ****
  152.       mePtr = menuPtr->entries[index];
  153.       mePtr->state = tkActiveUid;
  154.       EventuallyRedrawMenu(menuPtr, index);
  155.       Tk_Preserve((ClientData) mePtr);
  156.       if (mePtr->type == CASCADE_ENTRY) {
  157. !         result = Tcl_GlobalEval(menuPtr->interp, mePtr->command);
  158.           if (result == TCL_OK) {
  159.               result = PostSubmenu(menuPtr->interp, menuPtr, mePtr);
  160.           }
  161.       } else {
  162.           result = PostSubmenu(menuPtr->interp, menuPtr, (MenuEntry *) NULL);
  163. --- 2054,2068 ----
  164.       mePtr = menuPtr->entries[index];
  165.       mePtr->state = tkActiveUid;
  166.       EventuallyRedrawMenu(menuPtr, index);
  167.       Tk_Preserve((ClientData) mePtr);
  168.       if (mePtr->type == CASCADE_ENTRY) {
  169. !         if (mePtr->command != NULL) {
  170. !             result = Tcl_GlobalEval(menuPtr->interp, mePtr->command);
  171. !         } else {
  172. !             result = TCL_OK;
  173. !         }
  174.           if (result == TCL_OK) {
  175.               result = PostSubmenu(menuPtr->interp, menuPtr, mePtr);
  176.           }
  177.       } else {
  178.           result = PostSubmenu(menuPtr->interp, menuPtr, (MenuEntry *) NULL);
  179.  
  180. --
  181. tromey@cns.caltech.edu
  182. "In a riddle whose answer is chess, what is the only prohibited word?"
  183. I thought a moment and replied, "The word chess".
  184.     -- Jorge Luis Borges
  185.