AI
Animation
CGI
Compression
Console
Database
Debug
Dialects
Dialogs
Editor
Email
Encryption
Extension
External Library
File
File Handling
Files
Financial
FTP
Game
Games
Graphics
GUI
HTML
HTTP
Internet
LDC
Markup
Math
Module
Network
Networking
None
Other - Net
Parse
Patch
Printing
Protocol
Rebol
Scheme
Scientific
SDK
Security
Shell
Sound
SQL
TCP
Testing
Text
Text Processing
UI
User Interface
Util
Utility
VID
Visualization
Web
Win API
X-File
XML
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
]





            
            
        
Copyright © 2018 Rebol Software Foundation