picolisp

commit 51f946ff01be04acffbf08bd810378feb4f080b2
parent 1fc01c48ac276cc16e1cf0fe5adbf42496dfdf9c
Author: Alexander Burger <abu@software-lab.de>
Date:   Thu, 14 Mar 2013 09:21:13 +0100

'<layout>' function
Diffstat:
M
CHANGES
 | 
1
+
M
ersatz/picolisp.jar
 | 
0

M
lib/xhtml.l
 | 
32
++++++++++++++++++++++++++++++--
M
src/vers.h
 | 
2
+-
M
src64/version.l
 | 
4
++--

5 files changed, 34 insertions(+), 5 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
 * DDmar13 picoLisp-3.1.2
+   '<layout>' function
    'fold' analog to 'lowc' / 'uppc'
    'fold' second arg default zero
    Removed 'dbg' startup script
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/xhtml.l b/lib/xhtml.l
@@ -1,4 +1,4 @@
-# 06mar13abu
+# 14mar13abu
 # (c) Software Lab. Alexander Burger
 
 # *JS "*JS" *Style *Menu *Tab *ID
@@ -315,6 +315,35 @@
 (de <tip> ("Str" . "Prg")
    (style (cons 'title "Str") "Prg") )
 
+# Layout
+(de <layout> "Lst"
+   (let ("X" 0  "Y" 0)
+      (recur ("Lst" "Y")
+         (for "L" "Lst"
+            (let
+               ("Args" (mapcar eval (cddar "L"))
+                  "DX" (eval (caar "L"))
+                  "DY" (eval (cadar "L"))
+                  "Cls" (unless (sub? ":" (car "Args")) (pop '"Args"))
+                  "Style"
+                  (cons 'style
+                     (glue "; "
+                        (cons
+                           "position:absolute"
+                           (pack "top:" "Y" "px")
+                           (pack "left:" "X" "px")
+                           (if "DX"
+                              (pack "width:" @ "px")
+                              "min-width:100%" )
+                           (if "DY"
+                              (pack "height:" @ "px")
+                              "min-height:100%" )
+                           "Args" ) ) ) )
+               (prog1 (if "Cls" (list "Cls" "Style") "Style")
+                  (eval (cadr "L")) )
+               (let "X" (+ "X" "DX")
+                  (recurse (cddr "L") "Y") )
+               (inc '"Y" "DY") ) ) ) ) )
 
 # Menus
 (de urlMT (Url Menu Tab Id Str)
@@ -474,7 +503,6 @@
    (<$> Str Obj Msg Tab)
    (<0> Str) )
 
-
 # Interactive tree
 (de <tree> ("Url" "Path" "Tree" "Able?" "Excl?" "Expand" "Print")
    (default "Print" 'ht:Prin)
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,1,16};
+static byte Version[4] = {3,1,1,17};
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 06mar13abu
+# 14mar13abu
 # (c) Software Lab. Alexander Burger
 
-(de *Version 3 1 1 16)
+(de *Version 3 1 1 17)
 
 # vi:et:ts=3:sw=3