ami-extra: new package with utility/helper units common to all Amiga-like systems

git-svn-id: trunk@29404 -

.gitattributes

@@ -970,6 +970,12 @@ packages/a52/Makefile.fpc svneol=native#text/plain
 packages/a52/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/a52/fpmake.pp svneol=native#text/plain
 packages/a52/src/a52.pas svneol=native#text/plain
+packages/ami-extra/Makefile svneol=native#text/plain
+packages/ami-extra/Makefile.fpc svneol=native#text/plain
+packages/ami-extra/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/ami-extra/README.txt svneol=native#text/plain
+packages/ami-extra/fpmake.pp svneol=native#text/plain
+packages/ami-extra/src/cliputils.pas svneol=native#text/plain
 packages/amunits/Makefile svneol=native#text/plain
 packages/amunits/Makefile.fpc svneol=native#text/plain
 packages/amunits/Makefile.fpc.fpcmake svneol=native#text/plain

packages/ami-extra/Makefile.fpc

@@ -0,0 +1,91 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=ami-extra
+version=3.1.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake: fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources
+distinstall:	fpmake
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR)  --unitinstalldir=$(INSTALL_UNITDIR) -ie
+endif
+zipinstall:	fpmake
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT)

packages/ami-extra/Makefile.fpc.fpcmake

@@ -0,0 +1,23 @@
+#
+#   Makefile.fpc for Free Pascal Amiga-like Extra Units
+#
+
+[package]
+name=ami-extra
+version=3.1.1
+
+[target]
+units=cliputils
+
+[compiler]
+includedir=src
+sourcedir=src
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+.NOTPARALLEL:

packages/ami-extra/README.txt

@@ -0,0 +1,9 @@
+This package contains additional utility and helper units
+which are common to Amiga-like systems. Most utility units
+(which are not deprecated) from amunits package should be
+moved in here, and get compiled also for AROS and MorphOS.
+
+This package is not for interface units for 3rd party
+libraries, because those are mostly system specific, or
+contain system specific information (aligment, ABI dependent
+function call declarations, etc).

packages/ami-extra/fpmake.pp

@@ -0,0 +1,40 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('ami-extra');
+
+    P.Author := 'FPC core team';
+    P.License := 'LGPL with modification';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Description := 'ami-extra, additional units for Amiga-like systems';
+
+    P.Dependencies.Add('morphunits',[morphos]);
+    P.Dependencies.Add('arosunits',[aros]);
+    P.Dependencies.Add('amunits',[amiga]);
+
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.1.1';
+    P.SourcePath.Add('src');
+
+    P.OSes:=AllAmigaLikeOSes;
+
+    T:=P.Targets.AddUnit('cliputils.pas');
+
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}

packages/ami-extra/src/cliputils.pas

@@ -0,0 +1,127 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Free Pascal development team
+
+    Clipboard helper functions for Amiga-likes
+
+    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.
+
+ **********************************************************************}
+
+{$MODE OBJFPC}
+{$H+}
+unit cliputils;
+
+interface
+
+function GetTextFromClip(ClipUnit: Byte): string;
+function PutTextToClip(ClipUnit: Byte; Text: string): Boolean;
+
+implementation
+
+uses
+  exec, clipboard, iffparse;
+
+const
+  ID_FTXT = 1179932756;
+  ID_CHRS = 1128813139;
+
+function GetTextFromClip(ClipUnit: Byte): string;
+var
+  Iff: PIffHandle;
+  Error: LongInt;
+  Cn: PContextNode;
+  Buf: PChar;
+  Len: Integer;
+  Cu: LongInt;
+begin
+  Result := '';
+  Cu := ClipUnit;
+  Iff := AllocIff;
+  if Assigned(Iff) then
+  begin
+    InitIffAsClip(iff);
+    Iff^.iff_Stream := LongWord(OpenClipboard(Cu));
+    if Iff^.iff_Stream<>0 then
+    begin
+      if OpenIff(Iff, IFFF_READ) = 0 then
+      begin
+        if StopChunk(iff, ID_FTXT, ID_CHRS) = 0 then
+        begin
+          while True do
+          begin
+            Error := ParseIff(iff, IFFPARSE_SCAN);
+            if (Error <> 0) and (Error <> IFFERR_EOC) then
+              Break;
+            Cn := CurrentChunk(Iff);
+            if not Assigned(Cn) then
+            begin
+              Continue;
+            end;
+            Len := Cn^.cn_Size;
+            if (Cn^.cn_Type = ID_FTXT) and (Cn^.cn_ID = ID_CHRS) and (Len > 0) then
+            begin
+              GetMem(Buf, Len + 1);
+              FillChar(Buf^, Len + 1, #0);
+              try
+                ReadChunkBytes(Iff, Buf, Len);
+                Result := Result + string(Buf);
+              finally
+                FreeMem(Buf);
+              end;
+            end;
+          end;
+        end;
+        CloseIff(Iff);
+      end;
+      CloseClipboard(PClipBoardHandle(iff^.iff_Stream));
+    end;
+    FreeIFF(Iff);
+  end;
+end;
+
+function PutTextToClip(ClipUnit: Byte; Text: string): Boolean;
+var
+  Iff: PIffHandle;
+  TText: string;
+  Len: Integer;
+begin
+  Result := False;
+  Iff := AllocIff;
+  if Assigned(Iff) then
+  begin
+    InitIffAsClip(iff);
+    Iff^.iff_Stream := LongWord(OpenClipboard(ClipUnit));
+    if Iff^.iff_Stream <> 0 then
+    begin
+      if OpenIff(Iff, IFFF_WRITE) = 0 then
+      begin
+        if PushChunk(iff, ID_FTXT, ID_FORM, IFFSIZE_UNKNOWN) = 0 then
+        begin
+          if PushChunk(iff, 0, ID_CHRS, IFFSIZE_UNKNOWN) = 0 then
+          begin
+            Len := Length(Text);
+            TText := Text + #0;
+            Result := WriteChunkBytes(iff, @(TText[1]), Len) = len;
+            PopChunk(iff);
+          end;
+          PopChunk(iff);
+        end;
+        CloseIff(iff);
+      end;
+      CloseClipboard(PClipBoardHandle(iff^.iff_Stream));
+    end;
+    FreeIFF(Iff);
+  end;
+end;
+
+begin
+{$IF DEFINED(MORPHOS) OR DEFINED(AMIGA)}
+  InitIFFParseLibrary;
+{$ENDIF}
+end.