From: John Benediktsson Date: Mon, 13 Nov 2023 01:21:51 +0000 (-0800) Subject: classes.prettyprinter: removing in favor of classes.hierarchy. X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=cb51398f4b06f3004277f359f69abf54d8d6ce26 classes.prettyprinter: removing in favor of classes.hierarchy. --- diff --git a/extra/classes/prettyprinter/authors.txt b/extra/classes/prettyprinter/authors.txt deleted file mode 100644 index 11b4b75a08..0000000000 --- a/extra/classes/prettyprinter/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Jean-Marc Lugrin diff --git a/extra/classes/prettyprinter/prettyprinter-docs.factor b/extra/classes/prettyprinter/prettyprinter-docs.factor deleted file mode 100644 index f457a0945d..0000000000 --- a/extra/classes/prettyprinter/prettyprinter-docs.factor +++ /dev/null @@ -1,34 +0,0 @@ -! Copyright (C) 2023 Jean-Marc Lugrin. -! See https://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax ; -IN: classes.prettyprinter - -ARTICLE: "classes.prettyprinter" "Print the hierarchy of a class" -{ $vocab-link "classes.prettyprinter" } " supports the printing of the class hierarchy to the listener or to any text stream." $nl -"The class name and vocab name are clickable, a P indicates that the classs is PRIVATE." $nl -"See " { $link hierarchy. } "." -; - -HELP: hierarchy. -{ $values { "class" "a class, use " { $snippet "tuple" } " to print the whole hierarchy" } } -{ $description "Print the class hierarchy layout on the output stream, with the name of its vocabulary." } -{ $errors "Throws an error if " { $snippet "class" } " is not a class." } -{ $examples - { $unchecked-example "tuple hierarchy." } - { $unchecked-example " \"GADGETS.TXT\" utf8 [ gadget hierarchy. ] with-file-writer" } -} -; - -HELP: class-hierarchy -{ $values { "hash" "An " { $snippet "hashtable" } " mapping classes to list of children" } } -{ $description "Extract the hierarchy of all classes in the form of an hashtable" - "with the class as the key and a vector of all children class in alphabetic order as a child." } -{ $notes { "This is made public for other tools that want to explore the class hierarch." } } -; - -HELP: not-a-class-error -{ $description "Throws a " { $link not-a-class-error } "." } -{ $error-description "Thrown by " { $link hierarchy. } " if the parameter is not a class." } -; - -ABOUT: "classes.prettyprinter" diff --git a/extra/classes/prettyprinter/prettyprinter-tests.factor b/extra/classes/prettyprinter/prettyprinter-tests.factor deleted file mode 100644 index 1bb0664d35..0000000000 --- a/extra/classes/prettyprinter/prettyprinter-tests.factor +++ /dev/null @@ -1,20 +0,0 @@ -! Copyright (C) 2023 Jean-Marc Lugrin. -! See https://factorcode.org/license.txt for BSD license. - -USING: tools.test classes.prettyprinter assocs io.streams.string ; -IN: classes.prettyprinter.tests - -TUPLE: troot a b c ; - -TUPLE: tchild1 < troot aa ; - -TUPLE: tchild2 < troot bb ; - -{ { tchild1 tchild2 } } [ troot class-hierarchy at ] unit-test - -[ f hierarchy. ] must-fail - -{ "t < word\n" } [ [ t hierarchy. ] with-string-writer ] unit-test -{ "tchild1 < troot < tuple\n" } [ [ tchild1 hierarchy. ] with-string-writer ] unit-test -{ "troot < tuple\n| tchild1 IN: classes.prettyprinter.tests\n| tchild2 IN: classes.prettyprinter.tests\n" } - [ [ troot hierarchy. ] with-string-writer ] unit-test \ No newline at end of file diff --git a/extra/classes/prettyprinter/prettyprinter.factor b/extra/classes/prettyprinter/prettyprinter.factor deleted file mode 100644 index 4d6e8542a2..0000000000 --- a/extra/classes/prettyprinter/prettyprinter.factor +++ /dev/null @@ -1,91 +0,0 @@ -! Copyright (C) 2023 Jean-Marc Lugrin. -! See https://factorcode.org/license.txt for BSD license. - -! Print a class heierarchy in the listener -! or to a file: "TESTDUMP.TXT" utf8 [ gadget hierarchy. ] with-file-writer - - -USING: classes hashtables ui.gadgets assocs kernel sequences prettyprint vectors -math io formatting strings sorting accessors io.styles vocabs ; - -IN: classes.prettyprinter - -ERROR: not-a-class-error ; - -> swap write-object -; - - -: print-in ( c -- ) - vocabulary>> lookup-vocab dup name>> - dup ".private" tail? [ " P" ] [ " " ] if write ! Mark if private - " IN: " write - swap write-object -; - -: print-leader ( i -- ) - ! 2 * CHAR: . write ! leader - [ "| " ] replicate "" concat-as write - ! 1 CHAR: \x20 write -; - -: print-class ( c i -- ) - 2dup print-leader print-class-name ! ( c i -- c i ) - 2 * over name>> length + ! Current column c ci -- - dup in-col < [ in-col swap - CHAR: \x20 write ] [ drop ] if - print-in - nl -; - -: print-superclasses ( c -- ) - superclass-of dup - [ " < " write - [ print-class-name ] - [ print-superclasses ] bi - ] - [ drop ] - if -; - -: print-root-class ( c -- ) - [ print-class-name ] - [ print-superclasses ] bi - nl -; - - :: print-children ( h c i -- ) - i 0 = [ c print-root-class ] [ c i print-class ] if - c h at - [ h swap i 1 + print-children ] each - ; - -PRIVATE> - -: class-hierarchy ( -- hash ) - ! Hastable class -> empty mutable vector - classes [ drop V{ } clone ] zip-with >hashtable - ! for each child-class, add it to its parent vector - classes [ over add-child ] each - [ sort ] assoc-map -; - -: hierarchy. ( class -- ) - dup class? [ not-a-class-error ] unless - class-hierarchy - ! Print from the desired root class - swap 0 print-children -; diff --git a/extra/classes/prettyprinter/summary.txt b/extra/classes/prettyprinter/summary.txt deleted file mode 100644 index 723c4290d0..0000000000 --- a/extra/classes/prettyprinter/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Print a class hierarchy \ No newline at end of file diff --git a/extra/classes/prettyprinter/tags.txt b/extra/classes/prettyprinter/tags.txt deleted file mode 100644 index 8ba7ae8503..0000000000 --- a/extra/classes/prettyprinter/tags.txt +++ /dev/null @@ -1,2 +0,0 @@ -tools -reflection