home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / MenuMod.txt < prev    next >
Encoding:
Text File  |  1994-05-08  |  3.6 KB  |  141 lines  |  [TEXT/MSET]
  1. \ Menu class.
  2. \ Sept 90  mrh  item# anomalies fixed
  3.  
  4.  
  5. :class    MENU    super{ x-array }
  6. record
  7. {    int    RESID        \ Resource ID of this menu
  8.     var    MHNDL        \ Handle to menu heap storage
  9. }
  10.  
  11. :m ID:            inline{ get: resID}  get: resID  ;m
  12. :m PUTRESID:    inline{ put: resID}  put: resID  ;m
  13.  
  14. :m HANDLE:
  15.     inline{ get: mHndl}
  16.     get: mhndl  ;m
  17.  
  18. :m INIT:    \ ( xt1 ... xtN N resID -- )
  19.     put: resID  put: super  ;m
  20.  
  21. :m NEW:        \ ( addr len -- )  Allocates menu with title.
  22.             \ Non-resource-based.
  23.     str255  >r  0  int: resid  r>  call NewMenu
  24.     put: Mhndl  ;m
  25.  
  26. \ GetNew: and Release: are used if the menu is resource-based.
  27.  
  28. :m GETNEW:
  29.     0  int: resid  call GetRMenu  dup 0= ?error 127
  30.     put: mHndl  ;m
  31.  
  32. :m RELEASE:
  33.     get: mHndl  call ReleaseResource  ;m
  34.  
  35.  
  36. :m INSERT:    \ Inserts the menu in the menu bar.
  37.     get: Mhndl  word0  call InsertMenu  ;m
  38.  
  39.  
  40. :m NORMAL:    \ Removes hiliting on ALL menus!
  41.     word0  call HiliteMenu  ;m
  42.  
  43. :m ENABLE:    \ Enables a whole menu.
  44.     get: Mhndl  word0  call EnableItem  call DrawMenuBar  ;m
  45.  
  46. :m DISABLE:    \ Greys and disables a whole menu.
  47.     get: Mhndl  word0  call DisableItem  call DrawMenuBar  ;m
  48.  
  49.  
  50. \ Methods dealing with individual menu items.  We index from zero, as normal
  51. \ in Mops.  BUT NOTE that this is different from the Toolbox convention
  52. \ relating to menu items.
  53.  
  54. :m GETITEM:        \ ( item# -- addr len )  Gets string for item#
  55.     get: mhndl  swap 1+ makeint
  56.     buf255  call GetItem  buf255  count  ;m
  57.  
  58. :m PUTITEM:  { item# addr len -- }    \ Replaces menu item string
  59.     get: mhndl  item# 1+ makeint  addr len str255
  60.     call SetItem  ;m
  61.  
  62. :m INSERTITEM:  { item# addr len -- }    \ Inserts a new item, after item#.
  63.     get: mhndl  addr len str255  item# 1+ makeint
  64.     call InsMenuItem  ;m
  65.  
  66. :m DELETEITEM:    \ ( item# -- )  Deletes the item.
  67.     get: mhndl  swap 1+ makeint  call DelMenuItem  ;m
  68.  
  69.  
  70. :m ADD:        \ ( addr len -- )  Appends a menu item
  71.     str255  get: Mhndl
  72.     swap  call AppendMenu  ;m
  73.  
  74. :m ADDITEM:    add: self  ;m        \ Just for naming consistency
  75.  
  76. :m ADDRES:    \ ( type -- )  Adds all resources of a type
  77.     get: Mhndl swap  call AddResMenu  ;m
  78.  
  79.  
  80. :m ENABLEITEM:    \ ( item# -- )  Enables a menu item
  81.     get: Mhndl swap 1+ makeint  call EnableItem  ;m
  82.  
  83. :m DISABLEITEM:    \ ( item# -- )  Greys and disables an item
  84.     get: Mhndl swap 1+ makeint  call DisableItem  ;m
  85.  
  86.  
  87. :m OPENDESK:    \ ( item# -- )  Opens the desk accy for item#
  88.     savePort  getitem: self  2drop
  89.     word0  buf255  call OpenDeskAcc  word0 drop  restPort  ;m
  90.  
  91.  
  92. :m EXEC:    \ ( item# -- )  Executes the code for a menu item.
  93.  
  94. \ Menu handlers will have item# on the stack when they execute, and they
  95. \ should leave it there.  This way, they can ignore it if they want to,
  96. \ which will be the most common situation.
  97. \ If the item# is too great for this menu, we actually execute the last
  98. \ item rather than give an error.  This allows us to save memory 
  99. \ when a menu may have dozens of identical items such as fonts or DAs, as
  100. \ can happen with Font/DA Juggler or Suitcase.  But of course we don't
  101. \ alter the item# on the stack.
  102.  
  103.     dup  limit 1- min  exec: super  drop  normal: self  ;m
  104.  
  105.  
  106. :m CHECK:    \ ( item# -- )
  107.     get: Mhndl  swap 1+ makeInt  w 256
  108.     call CheckItem  ;m
  109.  
  110. :m UNCHECK:    \ ( item# -- )
  111.     get: Mhndl  swap 1+ makeInt  word0
  112.     call CheckItem  ;m
  113.  
  114. ;class
  115.  
  116.  
  117. \ Subclass AppleMenu facilitates standard Apple Menu support, by filling
  118. \ the menu with all the DAs at GetNew: time.
  119.  
  120. :class  APPLEMENU  super{ menu }
  121.  
  122. :m GETNEW:
  123.     getnew: super
  124.     'type DRVR  addRes: self  ;m
  125.  
  126. ;class
  127.  
  128.  
  129. \ Subclass EditMenu facilitates standard DA support.  The EXEC: method
  130. \ first calls SystemEdit so any active DA gets a go at it.
  131.  
  132. :class  EDITMENU  super{ menu }
  133.  
  134. :m EXEC:  { item# -- }
  135.     word0  item# makeint  call SystemEdit  i->l
  136.     IF        normal: self
  137.     ELSE    item#  exec: super
  138.     THEN  ;m
  139.  
  140. ;class
  141.