home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyAEUtils.p < prev    next >
Encoding:
Text File  |  1995-10-22  |  12.9 KB  |  456 lines  |  [TEXT/CWIE]
  1. unit MyAEUtils;
  2.  
  3. interface
  4.  
  5.     uses
  6.         TextEdit, AppleEvents;
  7.  
  8.     const
  9.         typeMyPropertyToken = 'PTok';
  10.         myPropertiesResType = 'MPRP';
  11.  
  12.     type
  13.         SuspendedEvent = record
  14.                 waiting: boolean;
  15.                 event, reply: AppleEvent;
  16.                 dispatcher: AEEventHandlerProcPtr;
  17.                 refcon: longint;
  18.             end;
  19.  
  20.     function GotRequiredParams (var event: AppleEvent): OSErr;
  21.  
  22.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: ptr; maximumSize: Size; var actualSize: Size): OSErr;
  23.  
  24.     procedure AECreate (var desc: AEDesc);
  25.     procedure AEDestroy (var desc: AEDesc); { dispose without error }
  26.     function AENull: AEDesc;
  27.  
  28.     function CreateStringDesc (s: Str255; var desc: AEDesc): OSErr;
  29.     function CreateLongDesc (n: longint; var desc: AEDesc): OSErr;
  30.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  31.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  32.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  33.  
  34.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  35.  
  36.     function GetDataFromAEDesc(var desc: AEDesc; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  37. { Guarentteed to preserve x on error }
  38.     function GetStringFromAEDesc (desc: AEDesc; var x: Str255): OSErr;
  39.     function GetLongFromAEDesc (desc: AEDesc; var x: longint): OSErr;
  40.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  41.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  42.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  43.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  44.  
  45.     function GetDataFromAERecord(var desc: AERecord; key: AEKeyword; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  46. { Guarentteed to preserve x on error }
  47.     function GetStringFromAERecord (var desc: AERecord; key: AEKeyword; var x: Str255): OSErr;
  48.     function GetLongFromAERecord (var desc: AERecord; key: AEKeyword; var x: longint): OSErr;
  49.     function GetTypeFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  50.     function GetBooleanFromAERecord (var desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  51.     function GetFSSpecFromAERecord (var event: AppleEvent; key: AEKeyword; var x: FSSpec): OSErr;
  52.     function GetEnumeratedFromAERecord (var event: AppleEvent; key: AEKeyword; var x: DescType): OSErr;
  53.  
  54.     function PutTESelectionToAERecord (var desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  55.     function PutStringToAERecord (var desc: AERecord; key: AEKeyword; s: Str255): OSErr;
  56.     function PutLongToAERecord (var desc: AERecord; key: AEKeyword; n: longint): OSErr;
  57.     function PutDateToAERecord (var desc: AERecord; key: AEKeyword; date: longint): OSErr;
  58.     function PutTypeToAERecord (var desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  59.     function PutBooleanToAERecord (var desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  60.     function PutFSSpecToAERecord (var desc: AppleEvent; key: AEKeyword; fs: FSSpec): OSErr;
  61.  
  62.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  63.  
  64.     function NullSuspendedEvent: SuspendedEvent;
  65.     function SuspendEvent (var event, reply: AppleEvent; dispatcher: AEEventHandlerProcPtr; refcon: longint; var se: SuspendedEvent): OSErr;
  66.     procedure ResumeEvent (var se: SuspendedEvent);
  67.  
  68. implementation
  69.  
  70.     uses
  71.         Memory, Resources, Errors, AEObjects, AERegistry;
  72.  
  73.     procedure AECreate (var desc: AEDesc);
  74.     begin
  75.         desc.descriptorType := typeNull;
  76.         desc.dataHandle := nil;
  77.     end;
  78.  
  79.     function AENull: AEDesc;
  80.         var
  81.             desc: AEDesc;
  82.     begin
  83.         AECreate(desc);
  84.         AENull := desc;
  85.     end;
  86.  
  87.     procedure AEDestroy (var desc: AEDesc);
  88.         var
  89.             junk: OSErr;
  90.     begin
  91.         junk := AEDisposeDesc(desc);
  92.         AECreate(desc);
  93.     end;
  94.  
  95.     function GotRequiredParams (var event: AppleEvent): OSErr;
  96.         var
  97.             typeCode: DescType;
  98.             actualSize: Size;
  99.             err: OSErr;
  100.     begin
  101.         err := AEGetAttributePtr(event, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);
  102.         if err = errAEDescNotFound then begin        (* we got all the required params: all is ok *)
  103.             err := noErr;
  104.         end else if err = noErr then begin
  105.             err := errAEEventNotHandled
  106.         end;
  107.         GotRequiredParams := err;
  108.     end;
  109.  
  110.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: ptr; maximumSize: Size; var actualSize: Size): OSErr;
  111.         var
  112.             err: OSErr;
  113.             result: AEDesc;
  114.             len: longint;
  115.     begin
  116.         actualSize := 0;
  117.         err := AECoerceDesc(desc, desiredType, result);
  118.         if err = noErr then begin
  119.             actualSize := GetHandleSize(result.dataHandle);
  120.             len := actualSize;
  121.             if len > maximumSize then begin
  122.                 len := maximumSize;
  123.             end;
  124.             BlockMoveData(result.dataHandle^, p, len);
  125.         end;
  126.         AEDestroy(result);
  127.         AEGetDescPtr := err;
  128.     end;
  129.  
  130.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  131.         var
  132.             psn: ProcessSerialNumber;
  133.     begin
  134.         psn.lowLongOfPSN := kCurrentProcess;
  135.         psn.highLongOfPSN := 0;
  136.         CreateSelfTarget := AECreateDesc(typeProcessSerialNumber, @psn, SizeOf(psn), desc);
  137.     end;
  138.  
  139.     function CreateStringDesc (s: Str255; var desc: AEDesc): OSErr;
  140.     begin
  141.         CreateStringDesc := AECreateDesc(typeChar, @s[1], length(s), desc);
  142.     end;
  143.  
  144.     function CreateLongDesc (n: longint; var desc: AEDesc): OSErr;
  145.     begin
  146.         CreateLongDesc := AECreateDesc(typeLongInteger, @n, SizeOf(n), desc);
  147.     end;
  148.  
  149.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  150.     begin
  151.         CreateTypeDesc := AECreateDesc(typeType, @t, SizeOf(t), desc);
  152.     end;
  153.  
  154.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  155.     begin
  156.         CreateBooleanDesc := AECreateDesc(typeBoolean, @b, SizeOf(b), desc);
  157.     end;
  158.  
  159.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  160.     begin
  161.         CreateFSSpecDesc := AECreateDesc(typeFSS, @fs, SizeOf(fs), desc);
  162.     end;
  163.  
  164.     function GetStringFromAEDesc (desc: AEDesc; var x: Str255): OSErr;
  165.         var
  166.             result: AEDesc;
  167.             err: OSErr;
  168.             len: longint;
  169.     begin
  170.         err := AECoerceDesc(desc, typeChar, result);
  171.         if err = noErr then begin
  172.             len := GetHandleSize(result.dataHandle);
  173.             if len > 255 then begin
  174.                 len := 255;
  175.             end;
  176.             x[0] := chr(len);
  177.             BlockMoveData(result.dataHandle^, @x[1], len);
  178.             AEDestroy(result);
  179.         end;
  180.         GetStringFromAEDesc := err;
  181.     end;
  182.  
  183.     function GetDataFromAEDesc(var desc: AEDesc; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  184.         var
  185.             actual_size: Size;
  186.             err: OSErr;
  187.     begin
  188.         err := AEGetDescPtr(desc, typ, datap, datalen, actual_size);
  189.         if (err = noErr) & (datalen <> actual_size) then begin
  190.             err := -14;
  191.         end;
  192.         GetDataFromAEDesc := err;
  193.     end;
  194.     
  195.     function GetLongFromAEDesc (desc: AEDesc; var x: longint): OSErr;
  196.         var
  197.             len: longint;
  198.             err: OSErr;
  199.             temp: longint;
  200.     begin
  201.         err := AEGetDescPtr(desc, typeLongInteger, @temp, SizeOf(temp), len);
  202.         if err = noErr then begin
  203.             x := temp;
  204.         end;
  205.         GetLongFromAEDesc := err;
  206.     end;
  207.  
  208.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  209.         var
  210.             len: longint;
  211.             err: OSErr;
  212.             temp: DescType;
  213.     begin
  214.         err := AEGetDescPtr(desc, typeType, @temp, SizeOf(temp), len);
  215.         if err = noErr then begin
  216.             x := temp;
  217.         end;
  218.         GetTypeFromAEDesc := err;
  219.     end;
  220.  
  221.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  222.         var
  223.             len: longint;
  224.             err: OSErr;
  225.             temp: boolean;
  226.     begin
  227.         err := AEGetDescPtr(desc, typeBoolean, @temp, SizeOf(temp), len);
  228.         if err = noErr then begin
  229.             x := temp;
  230.         end;
  231.         GetBooleanFromAEDesc := err;
  232.     end;
  233.  
  234.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  235.         var
  236.             err: OSErr;
  237.             len: longint;
  238.             temp: FSSpec;
  239.     begin
  240.         err := AEGetDescPtr(desc, typeFSS, @temp, SizeOf(temp), len);
  241.         if err = noErr then begin
  242.             x := temp;
  243.         end;
  244.         GetFSSpecFromAEDesc := err;
  245.     end;
  246.  
  247.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  248.         var
  249.             err: OSErr;
  250.     begin
  251.         err := noErr;
  252.         if (GetHandleSize(desc.dataHandle) <> SizeOf(DescType)) then begin
  253.             err := errAETypeError;
  254.         end;
  255.         if err = noErr then begin
  256.             BlockMoveData(desc.dataHandle^, @x, SizeOf(x));
  257.         end;
  258.         GetEnumeratedFromAEDesc := err;
  259.     end;
  260.  
  261.     function GetStringFromAERecord (var desc: AERecord; key: AEKeyword; var x: Str255): OSErr;
  262.         var
  263.             dummy: DescType;
  264.             actual: Size;
  265.             err: OSErr;
  266.             temp: Str255;
  267.     begin
  268.     { AEGetKeyPtr changed to AEGetParamPtr }
  269.         err := AEGetParamPtr(desc, key, typeChar, dummy, @temp[1], 255, actual);
  270.         if err = noErr then begin
  271.             temp[0] := chr(actual);
  272.             x := temp;
  273.         end;
  274.         GetStringFromAERecord := err;
  275.     end;
  276.  
  277.     function GetDataFromAERecord(var desc: AERecord; key: AEKeyword; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  278.         var
  279.             junk_type: DescType;
  280.             actual_size: Size;
  281.             err: OSErr;
  282.     begin
  283.         err := AEGetParamPtr(desc, key, typ, junk_type, datap, datalen, actual_size);
  284.         if (err = noErr) & (datalen <> actual_size) then begin
  285.             err := -14;
  286.         end;
  287.         GetDataFromAERecord := err;
  288.     end;
  289.     
  290.     function GetLongFromAERecord (var desc: AERecord; key: AEKeyword; var x: longint): OSErr;
  291.         var
  292.             dummy: DescType;
  293.             actual: Size;
  294.             err: OSErr;
  295.             temp: longint;
  296.     begin
  297.         err := AEGetParamPtr(desc, key, typeLongInteger, dummy, @temp, SizeOf(temp), actual);
  298.         if err = noErr then begin
  299.             x := temp;
  300.         end;
  301.         GetLongFromAERecord := err;
  302.     end;
  303.  
  304.     function GetTypeFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  305.         var
  306.             dummy: DescType;
  307.             actual: Size;
  308.             err: OSErr;
  309.             temp: DescType;
  310.     begin
  311.         err := AEGetParamPtr(desc, key, typeType, dummy, @temp, SizeOf(temp), actual);
  312.         if err = noErr then begin
  313.             x := temp;
  314.         end;
  315.         GetTypeFromAERecord := err;
  316.     end;
  317.  
  318.     function GetBooleanFromAERecord (var desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  319.         var
  320.             dummy: DescType;
  321.             actual: Size;
  322.             err: OSErr;
  323.             temp: boolean;
  324.     begin
  325.         err := AEGetParamPtr(desc, key, typeBoolean, dummy, @temp, SizeOf(temp), actual);
  326.         if err = noErr then begin
  327.             x := temp;
  328.         end;
  329.         GetBooleanFromAERecord := err;
  330.     end;
  331.  
  332.     function GetFSSpecFromAERecord (var event: AppleEvent; key: AEKeyword; var x: FSSpec): OSErr;
  333.         var
  334.             dummy: DescType;
  335.             actual: Size;
  336.             err: OSErr;
  337.             temp: FSSpec;
  338.     begin
  339.         err := AEGetParamPtr(event, key, typeFSS, dummy, @temp, SizeOf(temp), actual);
  340.         if err = noErr then begin
  341.             x := temp;
  342.         end;
  343.         GetFSSpecFromAERecord := err;
  344.     end;
  345.  
  346.     function GetEnumeratedFromAERecord (var event: AppleEvent; key: AEKeyword; var x: DescType): OSErr;
  347.         var
  348.             err: OSErr;
  349.             value: AEDesc;
  350.     begin
  351.         err := AEGetParamDesc(event, key, typeWildCard, value);
  352.         if err = noErr then begin
  353.             err := GetEnumeratedFromAEDesc(value, x);
  354.         end;
  355.         AEDestroy(value);
  356.         GetEnumeratedFromAERecord := err;
  357.     end;
  358.  
  359.     function PutTESelectionToAERecord (var desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  360.         var
  361.             hhhh: handle;
  362.             state: SignedByte;
  363.     begin
  364.         hhhh := handle(TEGetText(te));
  365.         state := HGetState(hhhh);
  366.         HLock(hhhh);
  367.         PutTESelectionToAERecord := AEPutParamPtr(desc, key, typeChar, ptr(ord(hhhh^) + te^^.selStart), te^^.selEnd - te^^.selStart);
  368.         HSetState(hhhh, state);
  369.     end;
  370.  
  371.     function PutStringToAERecord (var desc: AERecord; key: AEKeyword; s: Str255): OSErr;
  372.     begin
  373.         PutStringToAERecord := AEPutParamPtr(desc, key, typeChar, @s[1], length(s));
  374.     end;
  375.  
  376.     function PutLongToAERecord (var desc: AERecord; key: AEKeyword; n: longint): OSErr;
  377.     begin
  378.         PutLongToAERecord := AEPutParamPtr(desc, key, typeLongInteger, @n, SizeOf(n));
  379.     end;
  380.  
  381.     function PutDateToAERecord (var desc: AERecord; key: AEKeyword; date: longint): OSErr;
  382.         var
  383.             longdate: record
  384.                     zero: longint;
  385.                     date: longint;
  386.                 end;
  387.     begin
  388.         longdate.zero := 0;
  389.         longdate.date := date;
  390.         PutDateToAERecord := AEPutParamPtr(desc, key, 'ldt ', @longdate, SizeOf(longdate)); { typeLongDateTime }
  391.     end;
  392.  
  393.     function PutTypeToAERecord (var desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  394.     begin
  395.         PutTypeToAERecord := AEPutParamPtr(desc, key, typeType, @t, SizeOf(t));
  396.     end;
  397.  
  398.     function PutBooleanToAERecord (var desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  399.     begin
  400.         PutBooleanToAERecord := AEPutParamPtr(desc, key, typeBoolean, @b, SizeOf(b));
  401.     end;
  402.  
  403.     function PutFSSpecToAERecord (var desc: AppleEvent; key: AEKeyword; fs: FSSpec): OSErr;
  404.     begin
  405.         PutFSSpecToAERecord := AEPutParamPtr(desc, key, typeFSS, @fs, SizeOf(fs));
  406.     end;
  407.  
  408.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  409.         var
  410.             event, reply: AppleEvent;
  411.             err, junk: OSErr;
  412.             target: AEDesc;
  413.     begin
  414.         AECreate(reply);
  415.         err := CreateSelfTarget(target);
  416.         err := AECreateAppleEvent(class_id, event_id, target, kAutoGenerateReturnID, kAnyTransactionID, event);
  417.         AEDestroy(target);
  418.         if err = noErr then begin
  419.             junk := AESend(event, reply, kAENoReply + kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeOut, nil, nil);
  420.         end;
  421.         AEDestroy(event);
  422.         AEDestroy(reply);
  423.     end;
  424.  
  425.     function NullSuspendedEvent: SuspendedEvent;
  426.         var
  427.             se: SuspendedEvent;
  428.     begin
  429.         se.waiting := false;
  430.         NullSuspendedEvent := se;
  431.     end;
  432.  
  433.     function SuspendEvent (var event, reply: AppleEvent; dispatcher: AEEventHandlerProcPtr; refcon: longint; var se: SuspendedEvent): OSErr;
  434.         var
  435.             err: OSErr;
  436.     begin
  437.         se.event := event;
  438.         se.reply := reply;
  439.         se.dispatcher := dispatcher;
  440.         se.refcon := refcon;
  441.         err := AESuspendTheCurrentEvent(event);
  442.         se.waiting := err = noErr;
  443.         SuspendEvent := err;
  444.     end;
  445.  
  446.     procedure ResumeEvent (var se: SuspendedEvent);
  447.         var
  448.             junk: OSErr;
  449.     begin
  450.         if se.waiting then begin
  451.             se.waiting := false;
  452.             junk := AEResumeTheCurrentEvent(se.event, se.reply, se.dispatcher, se.refcon);
  453.         end;
  454.     end;
  455.  
  456. end.