picolisp

commit 6e293d1c884c3ce9f2ef368f1caafc65e0ffcf82
parent 9da01d6524ab906b1f1746687c349017decbeed6
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon, 19 Dec 2011 13:25:54 +0100

Minor +Hint / hint> additions
Diffstat:
M
ersatz/picolisp.jar
 | 
0

M
lib/form.l
 | 
60
+++++++++++++++++++++++++++++++++++++++---------------------
M
src/vers.h
 | 
2
+-
M
src64/version.l
 | 
4
++--

4 files changed, 42 insertions(+), 24 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/form.l b/lib/form.l
@@ -1,4 +1,4 @@
-# 01dec11abu
+# 19dec11abu
 # (c) Software Lab. Alexander Burger
 
 # *PRG *Top *Gui *Btn *Get *Got *Form *Evt *Lock *Spans
@@ -523,14 +523,15 @@
          (if (sym? I)
             ((; I hint) *JsHint)
             (let? Lst (get "*Lst" (- "*Cnt" (format *Get)))
-               (try 'hint>
-                  (get
-                     (if (gt0 (format *Form))
-                        (get Lst @)
-                        (get Lst 1 (+ (length (car Lst)) (format *Form)) 1) )
-                     'gui
-                     I )
-                  *JsHint ) ) )
+               (pair
+                  (hint>
+                     (get
+                        (if (gt0 (format *Form))
+                           (get Lst @)
+                           (get Lst 1 (+ (length (car Lst)) (format *Form)) 1) )
+                        'gui
+                        I )
+                     *JsHint ) ) ) )
          (prin
             (ht:Fmt
                (if (atom (car L))
@@ -549,7 +550,20 @@
    (pass extra) )
 
 (dm hint> (Str)
-   ((: hint) Str) )
+   ((: hint) (extra Str)) )
+
+(de dbHint (Str Var Cls Hook)
+   (make
+      (for
+         (Q
+            (goal
+               (cons
+                  (list 'db Var Cls Hook Str '@@) ) )
+            (prove Q) )
+         (let V (get (asoq '@@ @) -1 Var)
+            (unless (member V (made))
+               (link V) ) )
+         (T (nth (made) 24)) ) ) )
 
 
 (class +Hint1 +hint)
@@ -560,6 +574,7 @@
    (pass extra) )
 
 (dm hint> (Str)
+   (setq Str (extra Str))
    (extract '((S) (pre? Str S))
       (eval (: hint)) ) )
 
@@ -567,6 +582,7 @@
 (class +Hint2 +hint)
 
 (dm hint> (Str)
+   (setq Str (extra Str))
    (extract '((X) (pre? Str (if (atom X) X (car X))))
       (with (field -1) (eval (: hint))) ) )
 
@@ -743,6 +759,9 @@
 (dm val> ()
    (uppc (extra)) )
 
+(dm hint> (Str)
+   (extra (uppc Str)) )
+
 
 (class +Lowc)
 
@@ -752,6 +771,9 @@
 (dm val> ()
    (lowc (extra)) )
 
+(dm hint> (Str)
+   (extra (lowc Str)) )
+
 
 # Field enable/disable
 (de able ()
@@ -940,6 +962,9 @@
 
 (dm val> ())
 
+(dm hint> (Str)
+   Str )
+
 (dm init> ()
    (upd> This) )
 
@@ -2012,17 +2037,10 @@
                (collect (: objVar) (last (: objTyp)) NIL T (: objVar)) ) ) ) ) )
 
 (dm hint> (Str)
-   (make
-      (for
-         (Q
-            (goal
-               (cons
-                  (list 'db (: objVar) (last (: objTyp)) (: objHook) Str '@@) ) )
-            (prove Q) )
-         (let V (get (asoq '@@ @) -1 (: objVar))
-            (unless (member V (made))
-               (link V) ) )
-         (T (nth (made) 24)) ) ) )
+   (dbHint (extra Str)
+      (: objVar)
+      (last (: objTyp))
+      (: objHook) ) )
 
 (dm txt> (Obj)
    (if (ext? Obj)
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,8,10};
+static byte Version[4] = {3,0,8,11};
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 12dec11abu
+# 19dec11abu
 # (c) Software Lab. Alexander Burger
 
-(de *Version 3 0 8 10)
+(de *Version 3 0 8 11)
 
 # vi:et:ts=3:sw=3