REBOL [ Title: "Function help as string" Purpose: {This is the REBOL 'help function source code, modified so that instead of printing the help it puts it into a big string. The big string that is returned can be used as desired, perhaps for a text area on a window (the original use). Original lines are commented out, and new/replacement lines are marked. A better example of this concept can be found here: http://reb4.me/x/help.r} ] ;help: func [ ;original HELPSTRING: func [ ;helpstring "Prints information about words and values." 'word [any-type!] /local value args item type-name refmode types attrs rtype helptext ;helpstring ][ helptext: copy "" ;helpstring if unset? get/any 'word [ ; print trim/auto { ;original ; helpstring replacement line: ;helpstring append helptext rejoin [ trim/auto { ^-^-^-To use HELP, supply a word or value as its ^-^-^-argument: ^-^-^- ^-^-^-^-help insert ^-^-^-^-help system ^-^-^-^-help system/script ^-^-^-To view all words that match a pattern use a ^-^-^-string or partial word: ^-^-^-^-help "path" ^-^-^-^-help to- ^-^-^-To see words with values of a specific datatype: ^-^-^-^-help native! ^-^-^-^-help datatype! ^-^-^-Word completion: ^-^-^-^-The command line can perform word ^-^-^-^-completion. Type a few chars and press TAB ^-^-^-^-to complete the word. If nothing happens, ^-^-^-^-there may be more than one word that ^-^-^-^-matches. Press TAB again to see choices. ^-^-^-^-Local filenames can also be completed. ^-^-^-^-Begin the filename with a %. ^-^-^-Other useful functions: ^-^-^-^-about - see general product info ^-^-^-^-usage - view program options ^-^-^-^-license - show terms of user license ^-^-^-^-source func - view source of a function ^-^-^-^-upgrade - updates your copy of REBOL ^-^-^- ^-^-^-More information: http://www.rebol.com/docs.html ^-^-} newline ;helpstring ] ;helpstring ; exit ;original return helptext ;helpstring ] if all [word? :word not value? :word] [word: mold :word] if any [string? :word all [word? :word datatype? get :word]] [ types: dump-obj/match system/words :word sort types if not empty? types [ ; print ["Found these words:" newline types] ;original append helptext rejoin [ "Found these words: " ;helpstring newline ;helpstring types ;helpstring newline ;helpstring ] ; exit ;original return helptext ;helpstring ] ; print ["No information on" word "(word has no value)"] ;original append helptext rejoin [ ;helpstring "No information on " ;helpstring word ;helpstring " (word has no value)" ;helpstring newline ;helpstring ] ;helpstring ; exit ;original return helptext ;helpstring ] type-name: func [value] [ value: mold type? :value clear back tail value join either find "aeiou" first value ["an "] ["a "] value ] if not any [word? :word path? :word] [ ; print [mold :word "is" type-name :word] ;original append helptext rejoin [ ;helpstring mold :word ;helpstring " is " ;helpstring type-name :word ;helpstring newline ;helpstring ] ;helpstring ; exit ;original return helptext ;helpstring ] value: either path? :word [first reduce reduce [word]] [get :word] if not any-function? :value [ ; prin [uppercase mold word "is" type-name :value "of value: "] ;original append helptext rejoin [ ;helpstring uppercase mold word :helpstring word ;helpstring " is " ;helpstring type-name :value ;helpstring " of value: " ;helpstring ] ; print either object? value [print "" dump-obj value] [mold :value] ;original either object? value [ ;helpstring append helptext rejoin [ ;helpstring newline ;helpstring dump-obj value ;helpstring newline ;helpstring ] ;helpstring ] [ ;helpstring append helptext rejoin [ ;helpstring mold :value ;helpstring newline ;helpstring ] ;helpstring ] ;helpstring ; exit ;original return helptext ;helpstring ] args: third :value ; prin "USAGE:^/^-" ;original append helptext rejoin [ ;helpstring "USAGE:^/^-" ;helpstring ] ;helpstring ; if not op? :value [prin append uppercase mold word " "] ;original if not op? :value [ ;helpstring append helptext rejoin [ ;helpstring append uppercase mold word " " ;helpstring ] ;helpstring ] ;helpstring while [not tail? args] [ item: first args if :item = /local [break] if any [all [any-word? :item not set-word? :item] refinement? :item] [ ; prin append mold :item " " :original append helptext rejoin [ ;helpstring append mold :item " " ;helpstring ] ;helpstring ; if op? :value [prin append uppercase mold word " " value: none] ;original if op? :value [ ;helpstring append helptext rejoin [ ;helpstring append uppercase mold word " " ;helpstring value: none ;helpstring ] ;helpstring ] ;helpstring ] args: next args ] ; print "" :original append helptext newline ;helpstring args: head args value: get word ; print "^/DESCRIPTION:" ;helpstring append helptext rejoin [ ;helpstring "^/DESCRIPTION:" ;helpstring newline ;helpstring ] ;helpstring either string? pick args 1 [ ; print [tab first args] ;original append helptext rejoin [ ;helpstring tab ;helpstring first args ;helpstring newline ;helpstring ] ;helpstring args: next args ] [ ; print "^-(undocumented)" ;original append helptext rejoin [ ;helpstring "^-(undocumented)" ;helpstring newline ;helpstring ] ;helpstring ] ; print [tab uppercase mold word "is" type-name :value "value."] ;original append helptext rejoin [ ;helpstring tab ;helpstring uppercase mold word ;helpstring " is " ;helpstring type-name :value ;helpstring "value." ;helpstring newline ;helpstring ] ;helpstring if block? pick args 1 [ attrs: first args args: next args ] ; if tail? args [exit] ;original if tail? args [return helptext] while [not tail? args] [ item: first args args: next args if :item = /local [break] either not refinement? :item [ all [set-word? :item :item = to-set-word 'return block? first args rtype: first args] if none? refmode [ ; print "^/ARGUMENTS:" ;original append helptext rejoin [ ;helpstring "^/ARGUMENTS:" ;helpstring newline ;helpstring ] ;helpstring refmode: 'args ] ] [ if refmode <> 'refs [ ; print "^/REFINEMENTS:" ;original append helptext rejoin [ ;helpstring "^/REFINEMENTS:" ;helpstring newline ;helpstring ] ;helpstring refmode: 'refs ] ] either refinement? :item [ ; prin [tab mold item] ;original append helptext rejoin [ ;helpstring tab ;helpstring mold item ;helpstring ] ;helpstring ; if string? pick args 1 [prin [" --" first args] args: next args] ;original if string? pick args 1 [ append helptext rejoin [ " -- " first args ] args: next args ] ; print "" ;original append helptext newline ;helpstring ] [ if all [any-word? :item not set-word? :item] [ ; if refmode = 'refs [prin tab] ;original if refmode = 'refs [append helptext tab] ;helpstring ; prin [tab :item "-- "] ;original append helptext rejoin [ ;helpstring tab ;helpstring :item ;helpstring " -- " ;helpstring ] ;helpstring types: if block? pick args 1 [args: next args first back args] ; if string? pick args 1 [prin [first args ""] args: next args] ;original if string? pick args 1 [ append helptext rejoin [ first args " " ] args: next args ] if not types [types: 'any] ; prin rejoin ["(Type: " types ")"] ;original append helptext rejoin ["(Type: " types ")"] ;helpstring ; print "" ;original append helptext newline ;helpstring ] ] ] ; if rtype [print ["^/RETURNS:^/^-" rtype]] ;original if rtype [ ;helpstring append helptext rejoin[ ;helpstring "^/RETURNS:^/^- " ;helpstring rtype ;helpstring newline ;helpstring ] ;helpstring ] ;helpstring if attrs [ ; print "^/(SPECIAL ATTRIBUTES)" ;original append helptext rejoin [ ;helpstring "^/(SPECIAL ATTRIBUTES)" ;helpstring newline ;helpstring ] ;helpstring while [not tail? attrs] [ value: first attrs attrs: next attrs if any-word? value [ ; prin [tab value] ;original append helptext rejoin [tab value] ;helpstring if string? pick attrs 1 [ ; prin [" -- " first attrs] ;original append helptext rejoin [" -- " first attrs] ;helpstring attrs: next attrs ] ; print "" ;original append helptext newline ;helpstring ] ] ] ; exit ;original return helptext ;helpstring ] ;;Uncomment to test ;print "-------------------------------------" ;print HELPSTRING help ;print "-------------------------------------" ;print HELPSTRING print ;print "-------------------------------------" ;print HELPSTRING append ;print "-------------------------------------" ;print HELPSTRING help ;print "-------------------------------------" ;halt