{
This file is part of the Free Pascal run time library.
A file in Amiga system run time library.
Copyright (c) 1998-2003 by Nils Sjoholm
member of the Amiga RTL development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
History:
Added functions and procedures with array of const.
For use with fpc 1.0.7. They are in systemvartags.
10 Nov 2002.
Added the defines use_amiga_smartlink and
use_auto_openlib. Implemented opening of
the library.
13 Jan 2003.
Update for AmigaOs 3.9.
Added a const and a member to record tXRef;
Changed startupcode for library.
26 Jan 2003.
Changed cardinal to longword.
09 Feb 2003.
nils.sjoholm@mailbox.swipnet.se
}
{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
{$smartlink on}
{$endif use_amiga_smartlink}
unit amigaguide;
INTERFACE
uses exec,amigados, intuition, utility;
const
APSH_TOOL_ID = 11000;
StartupMsgID = (APSH_TOOL_ID+1) ; { Startup message }
LoginToolID = (APSH_TOOL_ID+2) ; { Login a tool SIPC port }
LogoutToolID = (APSH_TOOL_ID+3) ; { Logout a tool SIPC port }
ShutdownMsgID = (APSH_TOOL_ID+4) ; { Shutdown message }
ActivateToolID = (APSH_TOOL_ID+5) ; { Activate tool }
DeactivateToolID = (APSH_TOOL_ID+6) ; { Deactivate tool }
ActiveToolID = (APSH_TOOL_ID+7) ; { Tool Active }
InactiveToolID = (APSH_TOOL_ID+8) ; { Tool Inactive }
ToolStatusID = (APSH_TOOL_ID+9) ; { Status message }
ToolCmdID = (APSH_TOOL_ID+10); { Tool command message }
ToolCmdReplyID = (APSH_TOOL_ID+11); { Reply to tool command }
ShutdownToolID = (APSH_TOOL_ID+12); { Shutdown tool }
{ Attributes accepted by GetAmigaGuideAttr() }
AGA_Dummy = (TAG_USER) ;
AGA_Path = (AGA_Dummy+1);
AGA_XRefList = (AGA_Dummy+2);
AGA_Activate = (AGA_Dummy+3);
AGA_Context = (AGA_Dummy+4);
AGA_HelpGroup = (AGA_Dummy+5);
{ (ULONG) Unique identifier }
AGA_Reserved1 = (AGA_Dummy+6);
AGA_Reserved2 = (AGA_Dummy+7);
AGA_Reserved3 = (AGA_Dummy+8);
AGA_ARexxPort = (AGA_Dummy+9);
{ (struct MsgPort *) Pointer to the ARexx message port (V40) }
AGA_ARexxPortName = (AGA_Dummy+10);
{ (STRPTR) Used to specify the ARexx port name (V40) (not copied) }
AGA_Secure = (AGA_Dummy+11);
{ (BOOL) Disable "ONOPEN", "ONCLOSE" and "LINK RX", "LINK RXS", "LINK SYSTEM" commands (V41) }
Type
AMIGAGUIDECONTEXT = Pointer;
pAmigaGuideMsg = ^tAmigaGuideMsg;
tAmigaGuideMsg = record
agm_Msg : tMessage; { Embedded Exec message structure }
agm_Type : ULONG; { Type of message }
agm_Data : Pointer; { Pointer to message data }
agm_DSize, { Size of message data }
agm_DType, { Type of message data }
agm_Pri_Ret, { Primary return value }
agm_Sec_Ret : ULONG; { Secondary return value }
agm_System1,
agm_System2 : Pointer;
end;
{ Allocation description structure }
pNewAmigaGuide = ^tNewAmigaGuide;
tNewAmigaGuide = record
nag_Lock : BPTR; { Lock on the document directory }
nag_Name : STRPTR; { Name of document file }
nag_Screen : pScreen; { Screen to place windows within }
nag_PubScreen, { Public screen name to open on }
nag_HostPort, { Application's ARexx port name }
nag_ClientPort, { Name to assign to the clients ARexx port }
nag_BaseName : STRPTR; { Base name of the application }
nag_Flags : ULONG; { Flags }
nag_Context: Pointer; { NULL terminated context table }
nag_Node : STRPTR; { Node to align on first (defaults to Main) }
nag_Line : Longint; { Line to align on }
nag_Extens : pTagItem; { Tag array extension }
nag_Client : Pointer; { Private! MUST be NULL }
END;
CONST
{ public Client flags }
HTF_LOAD_INDEX = 0; { Force load the index at init time }
HTF_LOAD_ALL = 2; { Force load the entire database at init }
HTF_CACHE_NODE = 3; { Cache each node as visited }
HTF_CACHE_DB = 8; { Keep the buffers around UNTIL expunge }
HTF_UNIQUE = 32768; { Unique ARexx port name }
HTF_NOACTIVATE = 65536; { Don't activate window }
HTFC_SYSGADS = $80000000;
{ Callback function ID's }
HTH_OPEN = 0;
HTH_CLOSE = 1;
HTERR_NOT_ENOUGH_MEMORY = 100;
HTERR_CANT_OPEN_DATABASE = 101;
HTERR_CANT_FIND_NODE = 102;
HTERR_CANT_OPEN_NODE = 103;
HTERR_CANT_OPEN_WINDOW = 104;
HTERR_INVALID_COMMAND = 105;
HTERR_CANT_COMPLETE = 106;
HTERR_PORT_CLOSED = 107;
HTERR_CANT_CREATE_PORT = 108;
HTERR_KEYWORD_NOT_FOUND = 113;
Type
{ Cross reference node }
pXRef = ^tXRef;
tXRef = record
xr_Node : tNode; { Embedded node }
xr_Pad : WORD; { Padding }
xr_DF : Pointer; { Document defined in }
xr_File, { Name of document file }
xr_Name : STRPTR; { Name of item }
xr_Line : Longint; { Line defined at }
xr_Reserved : array [0..1] of Ulong;
END;
CONST
{ Types of cross reference nodes }
XR_GENERIC = 0;
XR_FUNCTION = 1;
XR_COMMAND = 2;
XR_INCLUDE = 3;
XR_MACRO = 4;
XR_STRUCT = 5;
XR_FIELD = 6;
XR_TYPEDEF = 7;
XR_DEFINE = 8;
Type
{ Callback handle }
pAmigaGuideHost = ^tAmigaGuideHost;
tAmigaGuideHost = record
agh_Dispatcher : tHook; { Dispatcher }
agh_Reserved, { Must be 0 }
agh_Flags,
agh_UseCnt : ULONG; { Number of open nodes }
agh_SystemData, { Reserved for system use }
agh_UserData : Pointer; { Anything you want... }
END;
CONST
{ Methods }
HM_FindNode = 1 ;
HM_OpenNode = 2 ;
HM_CloseNode = 3 ;
HM_Expunge = 10; { Expunge DataBase }
Type
{ HM_FindNode }
popFindHost = ^topFindHost;
topFindHost = record
MethodID : ULONG;
ofh_Attrs : pTagItem; { R: Additional attributes }
ofh_Node, { R: Name of node }
ofh_TOC, { W: Table of Contents }
ofh_Title, { W: Title to give to the node }
ofh_Next, { W: Next node to browse to }
ofh_Prev : STRPTR; { W: Previous node to browse to }
END;
{ HM_OpenNode, HM_CloseNode }
popNodeIO = ^topNodeIO;
topNodeIO = record
MethodID : ULONG;
onm_Attrs : pTagItem; { R: Additional attributes }
onm_Node, { R: Node name AND arguments }
onm_FileName, { W: File name buffer }
onm_DocBuffer : STRPTR; { W: Node buffer }
onm_BuffLen : ULONG; { W: Size of buffer }
onm_Flags : ULONG; { RW: Control flags }
END;
CONST
{ onm_Flags }
HTNF_KEEP = 0; { Don't flush this node UNTIL database is
* closed. }
HTNF_Reserved1 = 2 ; { Reserved for system use }
HTNF_Reserved2 = 4 ; { Reserved for system use }
HTNF_ASCII = 8 ; { Node is straight ASCII }
HTNF_Reserved3 = 16; { Reserved for system use }
HTNF_CLEAN = 32; { Remove the node from the database }
HTNF_DONE = 64; { Done with node }
{ onm_Attrs }
HTNA_Dummy = TAG_USER;
HTNA_Screen = (TAG_USER + 1); { Screen that window resides in }
HTNA_Pens = (TAG_USER + 2); { Pen array (from DrawInfo) }
HTNA_Rectangle = (TAG_USER + 3); { Window box }
HTNA_HelpGroup = (HTNA_Dummy+5); { (ULONG) unique identifier }
Type
{ HM_Expunge }
popExpungeNode = ^topExpungeNode;
topExpungeNode = record
MethodID : ULONG;
oen_Attrs : pTagItem; { R: Additional attributes }
END;
VAR AmigaGuideBase : pLibrary;
const
AMIGAGUIDENAME : Pchar = 'amigaguide.library';
FUNCTION AddAmigaGuideHostA(h : pHook; name : pCHAR; attrs : pTagItem) : POINTER;
FUNCTION AmigaGuideSignal(cl : POINTER) : ULONG;
PROCEDURE CloseAmigaGuide(cl : POINTER);
PROCEDURE ExpungeXRef;
FUNCTION GetAmigaGuideAttr(tag : ULONG; cl : POINTER; storage : POINTER) : LONGINT;
FUNCTION GetAmigaGuideMsg(cl : POINTER) : pAmigaGuideMsg;
FUNCTION GetAmigaGuideString(id : LONGINT) : pCHAR;
FUNCTION LoadXRef(lock : LONGINT; name : pCHAR) : LONGINT;
FUNCTION LockAmigaGuideBase(handle : POINTER) : LONGINT;
FUNCTION OpenAmigaGuideA(nag : pNewAmigaGuide; taglist : pTagItem) : POINTER;
FUNCTION OpenAmigaGuideAsyncA(nag : pNewAmigaGuide; attrs : pTagItem) : POINTER;
FUNCTION RemoveAmigaGuideHostA(hh : POINTER; attrs : pTagItem) : LONGINT;
PROCEDURE ReplyAmigaGuideMsg(amsg : pAmigaGuideMsg);
FUNCTION SendAmigaGuideCmdA(cl : POINTER; cmd : pCHAR; attrs : pTagItem) : LONGINT;
FUNCTION SendAmigaGuideContextA(cl : POINTER; attrs : pTagItem) : LONGINT;
FUNCTION SetAmigaGuideAttrsA(cl : POINTER; attrs : pTagItem) : LONGINT;
FUNCTION SetAmigaGuideContextA(cl : POINTER; id : ULONG; attrs : pTagItem) : LONGINT;
PROCEDURE UnlockAmigaGuideBase(key : LONGINT);
{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitAMIGAGUIDELibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
AMIGAGUIDEIsCompiledHow : longint;
IMPLEMENTATION
{$ifndef dont_use_openlib}
uses msgbox;
{$endif dont_use_openlib}
FUNCTION AddAmigaGuideHostA(h : pHook; name : pCHAR; attrs : pTagItem) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L h,A0
MOVE.L name,D0
MOVEA.L attrs,A1
MOVEA.L AmigaGuideBase,A6
JSR -138(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION AmigaGuideSignal(cl : POINTER) : ULONG;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVEA.L AmigaGuideBase,A6
JSR -072(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE CloseAmigaGuide(cl : POINTER);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVEA.L AmigaGuideBase,A6
JSR -066(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE ExpungeXRef;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L AmigaGuideBase,A6
JSR -132(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION GetAmigaGuideAttr(tag : ULONG; cl : POINTER; storage : POINTER) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L tag,D0
MOVEA.L cl,A0
MOVEA.L storage,A1
MOVEA.L AmigaGuideBase,A6
JSR -114(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetAmigaGuideMsg(cl : POINTER) : pAmigaGuideMsg;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVEA.L AmigaGuideBase,A6
JSR -078(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetAmigaGuideString(id : LONGINT) : pCHAR;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L id,D0
MOVEA.L AmigaGuideBase,A6
JSR -210(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION LoadXRef(lock : LONGINT; name : pCHAR) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L lock,A0
MOVEA.L name,A1
MOVEA.L AmigaGuideBase,A6
JSR -126(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION LockAmigaGuideBase(handle : POINTER) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L handle,A0
MOVEA.L AmigaGuideBase,A6
JSR -036(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION OpenAmigaGuideA(nag : pNewAmigaGuide; taglist : pTagItem) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L nag,A0
MOVEA.L taglist,A1
MOVEA.L AmigaGuideBase,A6
JSR -054(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION OpenAmigaGuideAsyncA(nag : pNewAmigaGuide; attrs : pTagItem) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L nag,A0
MOVE.L attrs,D0
MOVEA.L AmigaGuideBase,A6
JSR -060(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION RemoveAmigaGuideHostA(hh : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L hh,A0
MOVEA.L attrs,A1
MOVEA.L AmigaGuideBase,A6
JSR -144(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE ReplyAmigaGuideMsg(amsg : pAmigaGuideMsg);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L amsg,A0
MOVEA.L AmigaGuideBase,A6
JSR -084(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION SendAmigaGuideCmdA(cl : POINTER; cmd : pCHAR; attrs : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVE.L cmd,D0
MOVE.L attrs,D1
MOVEA.L AmigaGuideBase,A6
JSR -102(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION SendAmigaGuideContextA(cl : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVE.L attrs,D0
MOVEA.L AmigaGuideBase,A6
JSR -096(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION SetAmigaGuideAttrsA(cl : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVEA.L attrs,A1
MOVEA.L AmigaGuideBase,A6
JSR -108(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION SetAmigaGuideContextA(cl : POINTER; id : ULONG; attrs : pTagItem) : LONGINT;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cl,A0
MOVE.L id,D0
MOVE.L attrs,D1
MOVEA.L AmigaGuideBase,A6
JSR -090(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE UnlockAmigaGuideBase(key : LONGINT);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L key,D0
MOVEA.L AmigaGuideBase,A6
JSR -042(A6)
MOVEA.L (A7)+,A6
END;
END;
const
{ Change VERSION and LIBVERSION to proper values }
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of amigaguide.library}
{$Info don't forget to use InitAMIGAGUIDELibrary in the beginning of your program}
var
amigaguide_exit : Pointer;
procedure CloseamigaguideLibrary;
begin
ExitProc := amigaguide_exit;
if AmigaGuideBase <> nil then begin
CloseLibrary(AmigaGuideBase);
AmigaGuideBase := nil;
end;
end;
procedure InitAMIGAGUIDELibrary;
begin
AmigaGuideBase := nil;
AmigaGuideBase := OpenLibrary(AMIGAGUIDENAME,LIBVERSION);
if AmigaGuideBase <> nil then begin
amigaguide_exit := ExitProc;
ExitProc := @CloseamigaguideLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open amigaguide.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
AMIGAGUIDEIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of amigaguide.library}
var
amigaguide_exit : Pointer;
procedure CloseamigaguideLibrary;
begin
ExitProc := amigaguide_exit;
if AmigaGuideBase <> nil then begin
CloseLibrary(AmigaGuideBase);
AmigaGuideBase := nil;
end;
end;
begin
AmigaGuideBase := nil;
AmigaGuideBase := OpenLibrary(AMIGAGUIDENAME,LIBVERSION);
if AmigaGuideBase <> nil then begin
amigaguide_exit := ExitProc;
ExitProc := @CloseamigaguideLibrary;
AMIGAGUIDEIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open amigaguide.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
AMIGAGUIDEIsCompiledHow := 3;
{$Warning No autoopening of amigaguide.library compiled}
{$Warning Make sure you open amigaguide.library yourself}
{$endif dont_use_openlib}
END. (* UNIT AMIGAGUIDE *)
{
$Log: amigaguide.pas,v $
Revision 1.5 2003/02/10 17:59:46 nils
* fixes for delphi mode
Revision 1.4 2003/02/07 20:48:36 nils
* update for amigaos 3.9
* changed startcode for library
Revision 1.3 2003/01/14 18:46:04 nils
* added defines use_amia_smartlink and use_auto_openlib
* implemented autoopening of library
Revision 1.2 2002/11/17 20:28:53 nils
* added functions with array of const
}
syntax highlighted by Code2HTML, v. 0.9.1