From c0dbabcbe04a65e4e14a34acf9152c5cc54df389 Mon Sep 17 00:00:00 2001
From: stucco <haraldsteinlechner@gmail.com>
Date: Fri, 21 Jan 2011 15:43:02 +0100
Subject: [PATCH] Was wenn noch weitere features benoetigt werden hinzugefuegt

---
 presentation.p.fs |  9 +++++----
 sourceTag.fs      | 12 ++++++++++++
 2 files changed, 17 insertions(+), 4 deletions(-)
 create mode 100644 sourceTag.fs

diff --git a/presentation.p.fs b/presentation.p.fs
index 4a8fbbf..cf6bd68 100644
--- a/presentation.p.fs
+++ b/presentation.p.fs
@@ -173,7 +173,7 @@
 	<p> s" farbendemo.fs" 0 100 <source> </p>
 	<p> farbendemo </p>
 <np>
-	<h> !" Beliebige Wörter können Inhalte erzeugen!!" </h>
+	<h> !" Was wenn zusätzliche Formatierungstags benötigt werden?" </h>
 	( <p> <b> !" So kann man Aufzaehlungen erstellen" </b> </p>
 	<p>
 		<en>
@@ -182,9 +182,10 @@
 			<||> !" Makros generieren Inhalte" </||>
 		</en>
 	</p> )
-	<p> s" presentation.p.fs" 112 116 <source> </p>
-	<p> !" Die Operatoren sehen so aus:" </p>
-	<p> s" presentation.fs" 214 221 <source> </p>
+	<p> s" farbendemo.fs" 0 5 <source> </p>
+	<p> s" presentation.p.fs" 185 185 <source> </p>
+	<p> !" Die implementierung des Tags <source>:" </p>
+	<p> s" sourceTag.fs" 0 100 <source> </p>
 <np>	
 	<h> !" Spezielle (verwendete) Features von Forth" </h>
 	<br>
diff --git a/sourceTag.fs b/sourceTag.fs
new file mode 100644
index 0000000..7e8651f
--- /dev/null
+++ b/sourceTag.fs
@@ -0,0 +1,12 @@
+: printCodeHeader ( end start namelen addr 1/0 -- )  \ prints source code header containing line numbers
+  { showLines }
+  swap 2swap \ addr namelen end start
+	2dup > if swap then \ addr namelen start/end end/start
+	showLines if dup 0 <# #s #> nip else 0 then ptype-reset 1+ ptype-indent !
+  2swap \ start end addr namelen
+	showLines printsource
+;
+
+: {source} ( -- ) dup dup dup dup @ swap cell + @  2swap cell 2 * +
+		   @ swap cell 3 * + @ 1 printCodeHeader 4 cells + ptype-reset ;
+: <source> ( addr len from to -- , xt-{source} )  ['] {source} , , , , , ;