]> gitweb.factorcode.org Git - factor.git/commitdiff
help.syntax: fix use of literal strings
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 17 Aug 2023 21:16:28 +0000 (14:16 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 17 Aug 2023 21:16:55 +0000 (14:16 -0700)
basis/help/syntax/syntax-tests.factor
basis/help/syntax/syntax.factor

index 0828c41bbdb32923335ddecd8563b3f0f7d2c423..cb07a35f9beebb3e82ed98536e74e6416011eab3 100644 (file)
@@ -1,4 +1,4 @@
-USING: accessors eval help.markup help.syntax kernel parser
+USING: accessors eval help.markup help.syntax kernel math parser
 tools.test vocabs ;
 
 [
@@ -58,3 +58,11 @@ tools.test vocabs ;
 
     the other }
 ] unit-test
+
+{ { $description "the " { $link + } "'s " "are awesome" } } [
+    HELP{ $description the \ + "'s " are awesome }
+] unit-test
+
+{ { $description "the " { $link + } "'s " "are awesome" } } [
+    HELP{ $description "the " \ + "'s " are awesome }
+] unit-test
index b88751a2f9de966bae63795828758bc6e9793bed..2cbc1261a925072b0267be95d87bdf44a634d184 100644 (file)
@@ -13,47 +13,42 @@ DEFER: HELP{
 
 <PRIVATE
 
-:: parse-help-token ( end -- str/obj/f )
+:: parse-help-token ( end -- str/obj/f literal? )
     ?scan-token dup {
         [ "{" = [ \ HELP{ ] [ f ] if ]
         [ "syntax" lookup-word ]
         [ { [ "$" head? ] [ "help.markup" lookup-word ] } 1&& ]
         [ dup ?last ":{[(/\"" member-eq? [ search ] [ drop f ] if ]
     } 1|| {
-        { [ dup not ] [ drop ] }
-        { [ dup end eq? ] [ 2drop f ] }
+        { [ dup not ] [ drop ] }
+        { [ dup end eq? ] [ 2drop f ] }
         { [ dup parsing-word? ] [
-            nip V{ } clone swap execute-parsing first
-            dup wrapper? [ wrapped>> \ $link swap 2array ] when ] }
-        { [ dup ] [ nip ] }
+            [
+                nip V{ } clone swap execute-parsing first
+                dup wrapper? [ wrapped>> \ $link swap 2array ] when
+            ] keep \ " = ] }
+        { [ dup ] [ nip f ] }
     } cond ;
 
 : push-help-text ( accum sbuf obj -- accum sbuf' )
     [ dup empty? [ >string suffix! SBUF" " clone ] unless ]
     [ [ suffix! ] curry dip ] bi* ;
 
-: help-block? ( word -- ? )
-    {
-        $description $heading $subheading $syntax
-        $class-description $error-description $var-description
-        $contract $notes $curious $deprecated $errors
-        $side-effects $content $warning $subsections $nl
-        $list $table $example $unchecked-example $code
-    } member-eq? ;
-
-: push-help-space ( accum sbuf -- accum sbuf )
-    dup empty? [
-        over empty? not
-        pick ?last dup array? [ ?first ] when
-        help-block? not and
+: ?push-help-space ( accum sbuf obj -- accum sbuf' obj )
+    over empty? [
+        pick [ f ] [
+            last [ string? not ] [ \ $nl = not ] bi and
+        ] if-empty
     ] [
         dup last " (" member? not
-    ] if [ CHAR: \s suffix! ] when ;
+    ] if
+    over string? [ over ?first " .,;:)" member? not and ] when
+    [ [ CHAR: \s suffix! ] dip ] when ;
 
 :: parse-help-text ( end -- seq )
     V{ } clone SBUF" " clone [
         lexer get line>> :> m
-        end parse-help-token :> obj
+        end parse-help-token :> ( obj literal? )
         lexer get line>> :> n
 
         obj string? n m - 1 > and [
@@ -63,14 +58,9 @@ DEFER: HELP{
 
         obj [
             [
-                dup string? [
-                    dup ?first " .,;:)" member? [
-                        [ push-help-space ] dip
-                    ] unless append!
-                ] [
-                    [ push-help-space ]
-                    [ push-help-text ] bi*
-                ] if
+                literal? [ ?push-help-space ] unless
+                dup string? not literal? or
+                [ push-help-text ] [ append! ] if
             ] when*
         ] keep
     ] loop [ >string suffix! ] unless-empty >array ; inline