home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Libraries / Workbench / AppMenuItem.mod < prev    next >
Encoding:
Text File  |  1995-07-02  |  3.7 KB  |  113 lines

  1. (*************************************************************************
  2.  
  3.      $RCSfile: AppMenuItem.mod $
  4.   Description:
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.4 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/25 23:56:20 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE AppMenuItem;
  20.  
  21. IMPORT
  22.   SYS := SYSTEM,
  23.   e   := Exec,
  24.   u   := Utility,
  25.   d   := Dos,
  26.   wb  := Workbench,
  27.   Out;
  28.  
  29. CONST
  30.   VersionTag = "$VER: AppMenuItem 1.2 (19.9.94)\r\n";
  31.  
  32. VAR
  33.   myport  : e.MsgPortPtr;
  34.   appitem : wb.AppMenuItemPtr;
  35.   appmsg  : wb.AppMessagePtr;
  36.  
  37.   result, x, count : LONGINT;
  38.   success : BOOLEAN;
  39.   file : d.FileHandlePtr;
  40.  
  41.   userData : e.STRPTR;
  42.  
  43. BEGIN (* AppMenuItem *)
  44.   myport := NIL; appitem := NIL; appmsg := NIL;
  45.   result := 0; x := 0; count := 0; success := FALSE;
  46.   IF wb.base.version >= 37 THEN
  47.     myport := e.CreateMsgPort();
  48.     IF myport # NIL THEN
  49.       (* Add our own AppMenuItem to the Workbench Tools Menu *)
  50.       appitem := wb.AddAppMenuItem
  51.         ( 0,                                 (* Our ID# for item *)
  52.           SYS.VAL (LONGINT,
  53.             SYS.ADR ("SYS:Utilities/More")), (* Our UserData *)
  54.           "Browse Files",                    (* MenuItem text *)
  55.           myport, u.done );                  (* MsgPort, no tags *)
  56.       IF appitem # NIL THEN
  57.         Out.String
  58.           ("Select Workbench Tools demo menuitem 'Browse Files'\n");
  59.  
  60.         (* For this example, we allow the AppMenuItem to be selected *)
  61.         (* only once, then we remove it and exit                     *)
  62.         e.WaitPort (myport);
  63.         LOOP
  64.           IF count >= 1 THEN EXIT END;
  65.           appmsg := SYS.VAL (wb.AppMessagePtr, e.GetMsg (myport));
  66.           IF appmsg = NIL THEN EXIT END;
  67.           (* Handle messages from the AppMenuItem - we have only one *)
  68.           (* item so we don't have to check its appmsg.id number.    *)
  69.           (* We'll System() the command string that we passed as     *)
  70.           (* userdata when we added the menu item.                   *)
  71.           (* We find our userdata pointer in appmsg.userData         *)
  72.  
  73.           Out.String ("User picked AppMenuItem with ");
  74.           Out.Int (appmsg.numArgs, 0);
  75.           Out.String (" icons selected\n");
  76.           FOR x := 0 TO appmsg.numArgs - 1 DO
  77.             Out.String ("  #"); Out.Int (x + 1, 0);
  78.             Out.String (" name = '"); Out.String (appmsg.argList[x].name^);
  79.             Out.String ("'\n");
  80.           END;
  81.           INC (count);
  82.           file := d.Open
  83.             ( "CON:0/40/640/150/AppMenu Example/auto/close/wait",
  84.               d.oldFile );
  85.           IF file # NIL THEN
  86.             userData := SYS.VAL (e.STRPTR, appmsg.userData);
  87.             Out.String ("userData='"); Out.String (userData^);
  88.             Out.String ("'\n");
  89.             result := d.SystemTags
  90.               ( userData^,
  91.                 d.sysInput,  file,
  92.                 d.sysOutput, NIL,
  93.                 d.sysAsynch, d.DOSTRUE,
  94.                 u.done );
  95.             Out.String ("result = "); Out.Int (result, 0); Out.Ln;
  96.             (* If Asynch System() itself fails, we must close file *)
  97.             IF result = -1 THEN d.OldClose (file) END
  98.           END;
  99.           e.ReplyMsg (appmsg)
  100.         END;
  101.         success := wb.RemoveAppMenuItem (appitem)
  102.       END;
  103.       (* Clear away any messages that arrived at the last moment *)
  104.       LOOP
  105.         appmsg := SYS.VAL (wb.AppMessagePtr, e.GetMsg (myport));
  106.         IF appmsg = NIL THEN EXIT END;
  107.         e.ReplyMsg (appmsg)
  108.       END;
  109.       e.DeleteMsgPort (myport)
  110.     END
  111.   END
  112. END AppMenuItem.
  113.