From 9e1f82add6dafc9bf840807118bf8da7ad3b8ad3 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 22 Jul 2012 14:05:30 -0700
Subject: [PATCH] help.markup: check the number of arguments to help markup.

---
 basis/help/markup/markup.factor | 41 ++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 14 deletions(-)

diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index d0f9c98acc..cbae4bf82a 100644
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -5,8 +5,8 @@ combinators combinators.smart compiler.units definitions
 definitions.icons effects fry generic hashtables help.stylesheet
 help.topics io io.styles kernel locals make math namespaces
 parser present prettyprint prettyprint.stylesheet quotations
-see sequences sets slots sorting splitting strings urls vectors
-vocabs vocabs.loader words words.symbol ;
+see sequences sequences.private sets slots sorting splitting
+strings urls vectors vocabs vocabs.loader words words.symbol ;
 FROM: prettyprint.sections => with-pprint ;
 FROM: namespaces => set ;
 IN: help.markup
@@ -206,17 +206,30 @@ M: word link-long-text
 
 : topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline
 
+ERROR: number-of-arguments found required ;
+
+: check-first ( seq -- first )
+    dup length 1 = [ length 1 number-of-arguments ] unless
+    first-unsafe ;
+
+: check-first2 ( seq -- first second )
+    dup length 2 = [ length 2 number-of-arguments ] unless
+    first2-unsafe ;
+
 PRIVATE>
 
 : ($link) ( topic -- ) [ link-text ] topic-span ;
-: $link ( element -- ) first ($link) ;
+
+: $link ( element -- ) check-first ($link) ;
 
 : ($long-link) ( topic -- ) [ link-long-text ] topic-span ;
-: $long-link ( element -- ) first ($long-link) ;
+
+: $long-link ( element -- ) check-first ($long-link) ;
 
 : ($pretty-link) ( topic -- )
     [ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ;
-: $pretty-link ( element -- ) first ($pretty-link) ;
+
+: $pretty-link ( element -- ) check-first ($pretty-link) ;
 
 : ($long-pretty-link) ( topic -- )
     [ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ;
@@ -238,24 +251,24 @@ PRIVATE>
     [ $subsection* ] each ($blank-line) ;
 
 : $subsection ( element -- )
-    first $subsection* ;
+    check-first $subsection* ;
 
 : ($vocab-link) ( text vocab -- )
     >vocab-link write-link ;
 
 : $vocab-subsection ( element -- )
     [
-        first2 dup vocab-help
+        check-first2 dup vocab-help
         [ 2nip ($long-pretty-link) ]
         [ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ]
         if*
     ] ($subsection) ;
 
 : $vocab-link ( element -- )
-    first dup vocab-name swap ($vocab-link) ;
+    check-first dup vocab-name swap ($vocab-link) ;
 
 : $vocabulary ( element -- )
-    first vocabulary>> [
+    check-first vocabulary>> [
         "Vocabulary" $heading nl dup ($vocab-link)
     ] when* ;
 
@@ -296,7 +309,7 @@ PRIVATE>
     [ clear-unrelated-words ] [ notify-related-words ] bi ;
 
 : $related ( element -- )
-    first dup "related" word-prop remove
+    check-first dup "related" word-prop remove
     [ $see-also ] unless-empty ;
 
 : ($grid) ( style quot -- )
@@ -387,15 +400,15 @@ M: f ($instance)
         ] with-style
     ] ($block) ; inline
 
-: $see ( element -- ) first [ see* ] ($see) ;
+: $see ( element -- ) check-first [ see* ] ($see) ;
 
-: $synopsis ( element -- ) first [ synopsis write ] ($see) ;
+: $synopsis ( element -- ) check-first [ synopsis write ] ($see) ;
 
 : $definition ( element -- )
     "Definition" $heading $see ;
 
 : $methods ( element -- )
-    first methods [
+    check-first methods [
         "Methods" $heading
         [ see-all ] ($see)
     ] unless-empty ;
@@ -403,7 +416,7 @@ M: f ($instance)
 : $value ( object -- )
     "Variable value" $heading
     "Current value in global namespace:" print-element
-    first dup [ pprint-short ] ($code) ;
+    check-first dup [ pprint-short ] ($code) ;
 
 : $curious ( element -- )
     "For the curious..." $heading print-element ;