REBOL [ Title: "Help Patch" Author: "Ingo Hohmann" Version: 0.0.1 Date: 2003-11-20 File: %help-system.r Purpose: { Allows to add the following info to functions: return: [datatypes to be returned] category: [a function category e.g. math series] author: [author initials email what you want } library: [ level: 'intermediate platform: 'all type: [ tool ] domain: [patch] tested-under: [view linux] support: none license: none ] TODO: { add todo and date fields? } ] func: func [ {Defines a user function with given spec and body. *PATCHED* iho Allows in the spec the following additional info: return: [list of types] category: [list of categories] author: [author info] these additiona are purely informational } [catch] spec [block!] {Help string (opt) followed by arg words (and opt type and string)} body [block!] "The body block of the function" /local returns categories author fun pos ][ if all [pos: find spec first [return:] block? next pos] [ returns: pos/2 remove/part pos 2 ] if all [pos: find spec first [category:] block? next pos] [ categories: pos/2 remove/part pos 2 ] if all [pos: find spec first [author:] block? next pos] [ author: pos/2 remove/part pos 2 ] fun: throw-on-error [make function! spec body] pos: any [find third :fun /local tail third :fun ] if returns [insert pos compose/only [return: (returns)]] if categories [insert pos compose/only [category: (categories)]] if author [insert pos compose/only [author: (author)]] :fun ] add-function-info: func [ {Add additional info to an already defined function} [catch] :fun [function! native! action!] "The function to add info to" info [block!] "block of info blocks" return: [none] category: [help] author: ["Ingo Hohmann"] /local pos ][ either parse info [ some [ set-word! block! ] ][ insert any [find third :fun /local tail third :fun] info ][ throw make error! "info block has wrong contents" ] ] add-function-info func [ return: [function!] category: [development] Author: [RT "Ingo Hohmann"] ] help: func [ {Prints information about words and values. *PATCHED* iho Returns additional info on functions } 'word [any-type!] return: ["Does not return a value"] category: [help] author: [RT "Ingo Hohmann"] /local value args item name refmode types attrs rtype categorized author ][ if unset? get/any 'word [ print 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 ^-^-^-} exit ] 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] exit ] print ["No information on" word "(word has no value)"] exit ] 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] exit ] 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: "] print either object? value [print "" dump-obj value] [mold :value] exit ] args: third :value prin "USAGE:^/^-" if not op? :value [prin append uppercase mold word " "] 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 " " if op? :value [prin append uppercase mold word " " value: none] ] args: next args ] print "" args: head args value: get word print "^/DESCRIPTION:" either string? pick args 1 [ print [tab first args newline tab uppercase mold word "is" type-name :value "value."] args: next args ] [ print "^-(undocumented)" ] if block? pick args 1 [ attrs: first args args: next args ] if tail? args [exit] while [not tail? args] [ item: first args args: next args if :item = /local [break] either not refinement? :item [ all [set-word? :item :item = first [return:] block? first args rtype: first args] all [set-word? :item :item = first [category:] block? first args categorized: first args] all [set-word? :item :item = first [author:] block? first args author: first args] if none? refmode [ print "^/ARGUMENTS:" refmode: 'args ] ] [ if refmode <> 'refs [ print "^/REFINEMENTS:" refmode: 'refs ] ] either refinement? :item [ prin [tab mold item] if string? pick args 1 [prin [" --" first args] args: next args] print "" ] [ if all [any-word? :item not set-word? :item] [ if refmode = 'refs [prin tab] prin [tab :item "-- "] types: if block? pick args 1 [args: next args first back args] if string? pick args 1 [prin [first args ""] args: next args] if not types [types: 'any] prin rejoin ["(Type: " types ")"] print "" ] ] ] if rtype [print ["^/RETURNS:^/^-" rtype]] if categorized [print ["^/CATEGORIES:^/^-" categorized]] if attrs [ print "^/(SPECIAL ATTRIBUTES)" while [not tail? attrs] [ value: first attrs attrs: next attrs if any-word? value [ prin [tab value] if string? pick attrs 1 [ prin [" -- " first attrs] attrs: next attrs ] print "" ] ] ] exit ]