use reject instead of [ ... not ] filter.

[factor.git] / basis / see / see.factor

diff --git a/basis/see/see.factor b/basis/see/see.factor
index 37153b522903cc86fe3a21ab01142ab59fd81e94..b43b53de2370d1b7c1fb398545819c245691f939 100644 (file)
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes classes.builtin
 classes.intersection classes.mixin classes.predicate classes.singleton
@@ -6,8 +6,11 @@ classes.tuple classes.union combinators definitions effects generic
 generic.single generic.standard generic.hook io io.pathnames
 io.streams.string io.styles kernel make namespaces prettyprint
 prettyprint.backend prettyprint.config prettyprint.custom
-prettyprint.sections sequences sets sorting strings summary words
-words.symbol words.constant words.alias ;
+prettyprint.sections sequences sets slots sorting strings summary
+words words.symbol words.constant words.alias vocabs ;
+FROM: namespaces => set ;
+FROM: classes => members ;
+RENAME: members sets => set-members
 IN: see
 
 GENERIC: synopsis* ( defspec -- )
@@ -18,6 +21,7 @@ GENERIC: see* ( defspec -- )
 
 : synopsis ( defspec -- str )
     [
+        string-limit? off
         0 margin set
         1 line-limit set
         [ synopsis* ] with-in
@@ -39,12 +43,12 @@ M: word print-stack-effect? drop t ;
 
 : stack-effect. ( word -- )
     [ print-stack-effect? ] [ stack-effect ] bi and
-    [ effect>string comment. ] when* ;
+    [ pprint-effect ] when* ;
 
 <PRIVATE
 
 : seeing-word ( word -- )
-    vocabulary>> pprinter-in set ;
+    vocabulary>> dup [ lookup-vocab ] when pprinter-in set ;
 
 : word-synopsis ( word -- )
     {
@@ -76,9 +80,9 @@ M: hook-generic synopsis*
         [ stack-effect. ]
     } cleave ;
 
-M: method-body synopsis*
+M: method synopsis*
     [ definer. ]
-    [ "method-class" word-prop pprint-word ]
+    [ "method-class" word-prop pprint-class ]
     [ "method-generic" word-prop pprint-word ] tri ;
 
 M: mixin-instance synopsis*
@@ -88,6 +92,19 @@ M: mixin-instance synopsis*
 
 M: pathname synopsis* pprint* ;
 
+M: alias summary
+    [
+        0 margin set 1 line-limit set
+        [
+            {
+                [ seeing-word ]
+                [ definer. ]
+                [ pprint-word ]
+                [ stack-effect pprint-effect ]
+            } cleave
+        ] with-in
+    ] with-string-writer ;
+
 M: word summary synopsis ;
 
 GENERIC: declarations. ( obj -- )
@@ -101,6 +118,7 @@ M: object declarations. drop ;
 M: word declarations.
     {
         POSTPONE: delimiter
+        POSTPONE: deprecated
         POSTPONE: inline
         POSTPONE: recursive
         POSTPONE: foldable
@@ -135,7 +153,7 @@ M: mixin-class see-class*
     <block \ MIXIN: pprint-word
     dup pprint-word <block
     dup members [
-        hard line-break
+        hard add-line-break
         \ INSTANCE: pprint-word pprint-word pprint-word
     ] with each block> block> ;
 
@@ -165,12 +183,14 @@ M: array pprint-slot-name
         dup name>> ,
         dup class>> object eq? [
             dup class>> ,
-            initial: ,
-            dup initial>> ,
         ] unless
         dup read-only>> [
             read-only ,
         ] when
+        dup [ class>> object eq? not ] [ initial>> ] bi or [
+            initial: ,
+            dup initial>> ,
+        ] when
         drop
     ] { } make ;
 
@@ -179,19 +199,30 @@ M: array pprint-slot-name
     dup length 1 = [ first ] when
     pprint-slot-name ;
 
+: tuple-declarations. ( class -- )
+    \ final declaration. ;
+
+: superclass. ( class -- )
+    superclass dup tuple eq? [ drop ] [ "<" text pprint-word ] if ;
+
 M: tuple-class see-class*
     <colon \ TUPLE: pprint-word
-    dup pprint-word
-    dup superclass tuple eq? [
-        "<" text dup superclass pprint-word
-    ] unless
-    <block "slots" word-prop [ pprint-slot ] each block>
-    pprint-; block> ;
+    {
+        [ pprint-word ]
+        [ superclass. ]
+        [ <block "slots" word-prop [ pprint-slot ] each block> pprint-; ]
+        [ tuple-declarations. ]
+    } cleave
+    block> ;
 
 M: word see-class* drop ;
 
 M: builtin-class see-class*
-    drop "! Built-in class" comment. ;
+    <block
+    \ BUILTIN: pprint-word
+    [ pprint-word ]
+    [ <block "slots" word-prop [ pprint-slot ] each pprint-; block> ] bi
+    block> ;
 
 : see-class ( class -- )
     dup class? [
@@ -209,7 +240,10 @@ M: word see*
     ] tri ;
 
 : seeing-implementors ( class -- seq )
-    dup implementors [ method ] with map natural-sort ;
+    dup implementors
+    [ [ reader? ] [ writer? ] bi or ] reject
+    [ lookup-method ] with map
+    natural-sort ;
 
 : seeing-methods ( generic -- seq )
     "methods" word-prop values natural-sort ;
@@ -224,7 +258,7 @@ PRIVATE>
         dup class? [ dup seeing-implementors % ] when
         dup generic? [ dup seeing-methods % ] when
         drop
-    ] { } make prune ;
+    ] { } make set-members ;
 
 : see-methods ( word -- )
-    methods see-all nl ;
\ No newline at end of file
+    methods see-all nl ;