MODULE Lock2AppMenu;   (* Lock on/off im Tools-Menü der Workbench *)

FROM SYSTEM	 IMPORT CAST,
			ADR,
			ADDRESS,
			TAG;
FROM Arts	 IMPORT kickVersion;
FROM DosD	 IMPORT FileHandlePtr,
			newFile,
			SysTags;
FROM DosL	 IMPORT Open,
			System;
FROM ExecD	 IMPORT MsgPortPtr,
			MemReqs,
			MemReqSet;
FROM ExecL	 IMPORT FindPort,
			WaitPort,
			PutMsg,
			GetMsg,
			ReplyMsg,
			CopyMem,
			AllocVec,
			FreeVec;
FROM ExecSupport IMPORT CreatePort,
			DeletePort,
			IsMsgPortEmpty;
FROM String	 IMPORT BStrToStr,
			Insert;
FROM UtilityD	 IMPORT tagEnd;
FROM WorkbenchD	 IMPORT AppMenuItemPtr,
			AppMessage,
			AppMessagePtr,
			MType;
FROM WorkbenchL	 IMPORT AddAppMenuItemA,
			RemoveAppMenuItem;

CONST
  OS2 = 36;
  StopData = CAST(LONGINT, "Stop");

VAR
  ActivePortPtr,		(* Message-Port des bereits aktiven Programms *)
  PortPtr: MsgPortPtr;		(* eigener Message-Port *)
  onPtr,			(* "Lock on"-Menü *)
  offPtr: AppMenuItemPtr;	(* "Lock off"-Menü *)
  AppMsgPtr: AppMessagePtr;	(* Application- oder Stop-Nachricht *)
  ok: BOOLEAN;			(* Fehler bei Anweisung? *)

PROCEDURE Launch;   (* Menü einrichten und überwachen *)
PROCEDURE ExecuteLock;   (* Lock durchführen *)
VAR
  c: LONGINT;				(* Zählvariable *)
  ShellPtr: FileHandlePtr;              (* Ausgabefenster *)
  LockArg,				(* Befehl für System-Anweisung *)
  VolName: ARRAY [0..255] OF CHAR;	(* Datenträgername *)
  VolNamePtr: POINTER TO CHAR;		(* Zeiger darauf *)
  ASynch: BOOLEAN;			(* asynchron oder nicht? *)
  tagbuf: ARRAY [0..12] OF LONGINT;	(* Puffer für TAG-Funktion *)
  Error: LONGINT;		        (* Fehlernummer der System-Anweisung *)
BEGIN
  ShellPtr := Open(ADR("CON:0/25/640/150/Lock/AUTO/WAIT/CLOSE"), newFile);
	(* Ausgabefenster öffnen *)
  FOR c := 0 TO AppMsgPtr^.numArgs - 1 DO
    VolNamePtr := ADR(VolName);
    CopyMem(ADDRESS(AppMsgPtr^.argList^[c].lock^.volume^.name),
            VolNamePtr,
            LONGINT(AppMsgPtr^.argList^[c].lock^.volume^.name^[0]) + 2);
	(* Datenträger in VolName kopieren; er wird im BString-Format *)
	(* geliefert, d. h. im ersten Zeichen steht die Länge des Strings *)
    CASE AppMsgPtr^.id OF
      0: LockArg := 'Lock ":" on';|   (* Menü "Lock on" ausgewählt *)
      1: LockArg := 'Lock ":" off';   (* Menü "Lock off" ausgewählt *)
    END;   (* CASE *)
    BStrToStr(VolName);   (* Länge aus dem BString VolName eliminieren *)
    Insert(LockArg, 6, VolName);   (* Befehl zusammensetzen *)
    IF c = AppMsgPtr^.numArgs - 1 THEN   (* Asynchrone Ausführung nur beim *)
      ASynch := TRUE;                    (* letzen Mal, damit man für alle *)
    ELSE                                 (* Argumente das gleiche Fenster *)
      ASynch := FALSE;                   (* verwenden kann und sich das Dos *)
    END;   (* IF *)                      (* dann ums Schließen kümmert *)
    Error := System(ADR(LockArg),   (* Ausführung *)
                    TAG(tagbuf,
                        sysInput, NIL,
                        sysOutput, LONGINT(ShellPtr),
                        sysASynch, ASynch,
                        sysUserShell, TRUE,
                        tagEnd));
  END;   (* FOR *)
  IF AppMsgPtr^.numArgs = 0 THEN     (* kein Icon ausgewählt? *)
      Error := System(ADR("Lock"),   (* ==> Lock Fehlermeldung *)
                      TAG(tagbuf,    (* ausgeben lassen *)
                          sysInput, NIL,
                          sysOutput, LONGINT(ShellPtr),
                          sysASynch, TRUE,
                          sysUserShell, TRUE,
                          tagEnd));
  END;   (* IF *)
END ExecuteLock;
BEGIN
  PortPtr := CreatePort(ADR("Lock2AppMenu"), 0);   (* Message-Port *)
  onPtr := AddAppMenuItemA(0, NIL, ADR("Lock on"), PortPtr, NIL);
  offPtr := AddAppMenuItemA(1, NIL, ADR("Lock off"), PortPtr, NIL);
	(* Application-Menüs einrichten *)
  LOOP
    WaitPort(PortPtr);   (* auf Message warten *)
    REPEAT
      AppMsgPtr := GetMsg(PortPtr);
      IF AppMsgPtr^.type = appMenuItem THEN   (* Menü ausgewählt ? *)
        ExecuteLock;                          (* ==> Lock ausführen *)
      ELSIF (AppMsgPtr^.type = toolExit)
             AND (AppMsgPtr^.userData = StopData) THEN   (* Stop-Nachricht? *)
        ReplyMsg(AppMsgPtr);
        EXIT;                                            (* ==> beenden *)
      END;   (* IF *)
      ReplyMsg(AppMsgPtr);
    UNTIL IsMsgPortEmpty(PortPtr);
  END;   (* LOOP *)
END Launch;

PROCEDURE Remove;   (* Stop-Nachricht an laufendes Programm schicken *)
BEGIN
  PortPtr := CreatePort(NIL, 0);   (* Message-Port *)
  AppMsgPtr := AllocVec(SIZE(AppMessage), MemReqSet{memClear});
  WITH AppMsgPtr^ DO   (* Stop-Nachricht initialisieren *)
    message.replyPort := PortPtr;
    type := toolExit;
    userData := StopData;
  END;   (* WITH *)
  PutMsg(ActivePortPtr, AppMsgPtr);   (* Nachricht schicken *)
  WaitPort(PortPtr);   (* auf Bestätigung warten *)
  FreeVec(AppMsgPtr);
END Remove;

BEGIN   (* Main *)
  IF kickVersion >= OS2 THEN   (* OS 2.0 oder höher vorhanden? *)
    ActivePortPtr := FindPort(ADR("Lock2AppMenu"));
    	(* Message-Port des eventuell schon aktiven Programms suchen *)
    IF ActivePortPtr = NIL THEN   (* Lock2AppMenu noch nicht aktiv *)
      Launch;   (* also starten *)
    ELSE   (* bereits aktiv *)
      Remove;   (* also beenden *)
    END;   (* IF *)
  END;   (* IF *)

CLOSE   (* Ressourcen freigeben *)
  IF onPtr # NIL THEN
    ok := RemoveAppMenuItem(onPtr);
  END;   (* IF *)
  IF offPtr # NIL THEN
    ok := RemoveAppMenuItem(offPtr);
  END;   (* IF *)
  IF PortPtr # NIL THEN
    DeletePort(PortPtr);
  END;   (* IF *)

END Lock2AppMenu.
