Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[REBOL] Re: Core 2.6 - Last minute requests - take your chance!

From: ingo:2b1 at: 7-Apr-2002 22:19

Hi Rebols, here are some of my ideas: 1) trim/align removes all spaces/tabs at the beginning and end of the string, and after each newline. 2) align left/right/center aligns a string to a given lengths, works on all lines, if the string has embedded newlines 3) ask/default displays a default entry, which may be edited. 4) and here is my patch to 'help again, which allows to use it on paths, it works on 2.5, but as I don't have the 2.6 beta, I can't check if it works on 2.6, too (IIRC the handling of paths has changed there?). I implemented it in a way to make as little change to the orginal code. I expressly give permission to RebolTech to use this in whatever way the like. help: func [ { Prints information about words and values. *PATCHED* (iho) works on paths } 'word [any-type!] /local value args item name refmode types attrs rtype type-name ][ if unset? get/any 'word [ print trim/auto { ^-^-^-^-The help function provides a simple way to get ^-^-^-^-information about words and values. To use it ^-^-^-^-supply a word or value as its argument: ^-^-^-^- ^-^-^-^-^-help insert ^-^-^-^-^-help find ^-^-^-^-To view all words that match a pattern: ^-^-^-^-^-help "path" ^-^-^-^-^-help to- ^-^-^-^-To view all words of a specified datatype: ^-^-^-^-^-help native! ^-^-^-^-^-help datatype! ^-^-^-^-There is also word completion from the command ^-^-^-^-line. Type a few chars and press TAB to complete ^-^-^-^-the word. If nothing happens, there is more than ^-^-^-^-one word that matches. Enough chars are needed ^-^-^-^-to uniquely identify the word. ^-^-^-^-Other useful functions: ^-^-^-^-^-about - for general info ^-^-^-^-^-usage - for the command line arguments ^-^-^-^-^-license - for the terms of user license ^-^-^-^-^-source func - print source for given function ^-^-^-^-^-upgrade - updates your copy of REBOL ^-^-^-^- ^-^-^-^-For more information, see the user guides. ^-^-^-} exit ] if all [word? :word not value? :word] [word: mold :word] if any [string? :word all [word? :word datatype? get :word]] [ types: copy [] attrs: second system/words foreach item first system/words [ value: copy " " change value :item if all [not unset? first attrs any [ all [string? :word find value word] all [not string? :word datatype? get :word (get :word) type? first attrs] ] ] [ repend value [" (" type? first attrs ")"] append types value ] attrs: next attrs ] sort types if not empty? types [ print "Found these words:" foreach item types [print [tab item]] 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 ] ; \/ \/ \/ start changes by iho if all [ word? :word object? get :word ] [ word: get :word ] if not word? :word [ ; check for path first, the value? check wouldn't work on a path! if path? :word [ use [ obj ; the "valid" path (last path part, that's not a ; refinement) as object! parts ; block containing the paths parts i ; position in path j ; loop variable pth ; valid path for printing as path! ] [ ; split the path ... parts: parse mold :word "/" ; and find out, if first element of path exists if error? try [obj: get to-word first parts] [ print ["Path:" :word "not found"] obj: to-word first parts help :obj exit ] ; find the last part of the path, that exists, and is no ; refinement i: 2 while [all [object? :obj i <= length? parts] ] [ ; when error here, it's first refinement (or nonsense) either not error? try [obj: get in obj to-word pick parts i] [ i: i + 1 ] [ break ] ] ; build the path for printing pth: first parts for j 2 i - 1 1 [ append pth rejoin ["/" pick parts j ] ] prin rejoin [{Valid subpath "} pth] ; Test whether what we found is a function and call help ; accordingly ... either any-function? :obj [ print rejoin [{" is } form type? :obj ":^/" ] help 'obj ][ either object? :obj [ print {" is:^/} help :obj ] [ print {"^/} help obj ] ; either object? ] ; either function? ] ; use exit ] ; if path? if object? :word [ use [ wrd ; word in object wrdv ; value of said word hlp ; functions help string format ; formatting function line ; output line line2 ; output line (type part) ] [ format: func [s][ trim/lines s ; replace/all either 30 > length? s [s][ join copy/part s 30 " ..." ] ; ] "^/" "^^/" ] print "object with fields:" foreach wrd next first :word [ line: copy " " line2: copy " " change line wrd ; check if the word has a value either value? in :word wrd [ wrdv: get in :word wrd change line2 rejoin ["(" type? :wrdv ")" ] either any-function? :wrdv [ print rejoin [tab line " " line2 " " either string? hlp: pick pick :wrdv 3 1 [ format hlp]["..."]] ] [ print rejoin [ tab line " " line2 " " either object? wrdv ["..."][ format mold wrdv ] ] ] ; either any ... true ] [ change line2 "()" print rejoin [ tab line " " line2 " Value is not set"] ] ; if value? ] ; foreach exit ] ; use ] ; if object? get :word ] ; if not word? ; /\ /\ /\ end changes by iho value: get word if not any-function? :value [ print [uppercase mold word "is" type-name :value "of 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] 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 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 ]