REBOL [ 
    Title: "Pretty Printer"
    Date:  17-Sep-1999
    Author: "Ingo Hohmann"
    email: ingo@2b1.de
    Site: http://www.2b1.de/
    Purpose: "Prettyfies REBOL Sourcecode"
    Name: "PrettyPrinter"
    File: %pretty.r
    Rights: {(c) 1999 Ingo Hohmann - free for any use, except that
	    modifications to this script will have to stay free.
	    If you improve this script, please tell me about it.}
    category: 'script
    version: 0.9.0
    status: 'beta
    comments: {
So far, about the only thing it does is getting the indentation right.
Doesn't try to discuss your habit where to start new lines.
}

    usage: {
The script asks for the name of script to be pretty printed.
After doing its job, the modified version is displayed in a pager.
Exit the pager with "q" (get help with "h") and you are asked to
name the file to save the new script to.
}
    Known-bugs: [
       {doesn't like escaped " signs in " delimited strings}
       {doesn't work on itself (see above)}
    ]
]

;
; try loading my modules, if not use ...
;

if error? try [
   module 'Timeline.r
   import %iho-tools.r 
] [

;
; Functions copied over from my startup files ...
;

; author ???
set '++ func ['word] [set word (get word) + 1]
set '-- func ['word] [set word (get word) - 1]

prompt: func [ "prompts for an editable string" 
               prompts defaults 
               /local prom 
                      "I don't want to change the string given to me"] [ 
   prom: copy prompts 
   append prom defaults 
   ask head insert/dup tail prom "^H" length? defaults 
] 

;
; A menu system, needed for pager
;

menu-object: make object! [

       header: copy "^LHelp"
       menus: copy []

       init: func [ "Initialize menu" /data men [block!]] [
	   either data [menus: copy men]
		       [menus: copy []]
       ] ; init

       FIXME: "add /at position  refinement"
       add: func [ "Adds a new menuline"
		   key [char! none!] help [string! none!] action
		   [block! none!]] [
	   append menus key
	   append menus help
	   append/only menus action
       ] ; add

       show: func [ "Shows the menu" ] [
           print rejoin [ header ]
	   foreach [key help action] menus [
	       prin either char? key
		      [rejoin ["("key") "]]
		      ["    "]
	       print either string? help
	              [help]
		      [""]
	   ]
	   print " "
       ] ; show

       ask: func [ "Waits for a keypress, and DOes menu action" 
		   /local con c key help action ] [
	   con: open/binary [scheme: 'console]
	   wait con
	   c: to-char to-integer copy con
	   foreach [key help action] menus [
	       if key == c [
		   if error? try [
	                if error? err: try action [
			  print rejoin ["Error in menu function: " action]
                          if confirm "would you like to see it (y/N)? " [
                             print mold disarm err
                          ]
			  return 'error
     		        ] [ 
			   'none
		        ] 
		   ] [
		   return 'ok
		 ]
	       ] 
	   ]
	   return 'not_found
       ] ; ask

       loop: func [ {After keypress, starts waiting for the next key,
		     you'd better have a halt in one of your menu actions}
		     /show "always show the menu, before waiting for keypress" 
		     /do "always do action before waiting" 
		         todo [block!] "action to do"] [
	   while [ true ] [
	       if show [ self/show ]
	       if do   [ if error? try todo [
			    print "Error while doing menu action!" 
			 ] ]
	       ask
	   ]
       ] ; loop    
;   ] ; use
] ; make menu

;
; A text pager
;

; extracted from messenger.r by Bohdan Lechnowsky <bo@rebol.com>
; Andrew M Grossmann <Andrew.M.Grossmann@ >
; changed by iho
pager: make object! [ 
    header: [ "^LPager" ]
    footer: [ perc "% command: " ]
    curr-line: 1
    view-lines: 25
    FIXME: "view-columns: 80" 
    content: copy ""
    keep-going: true

    init-header: func [new-hdr] [
        header: copy new-hdr
    ]

    init-footer: func [new-foot] [
	footer: copy new-foot
    ]

    validate: func [] [
        if curr-line < 1 [curr-line: 1]
        if curr-line > ((length? content) - view-lines) [
	   curr-line: (length? content) - view-lines
	]
    ]

    menu: make menu-object [
      menus: [
	none "Paging" none
        #"b" "Back one page" [curr-line: curr-line - view-lines  validate]
        #"f" "Forward one page" [
	     curr-line: curr-line + view-lines  validate
	]
        #" " "forward one page" [
	     curr-line: curr-line + view-lines  validate
        ]
        #"p" "Previous line" [curr-line: curr-line - 1           validate]
        #"n" "Next line" [curr-line: curr-line + 1 validate]
	none  "Window" none
        #","  "decrease view lines by 1"  [view-lines: view-lines - 1]
        #"."  "increase view lines by 1"  [view-lines: view-lines + 1]
        #"<"  "decrease view lines by 5"  [view-lines: view-lines - 5]
        #">"  "increase view lines by 5"  [view-lines: view-lines + 5]
	none  "Other" none
        #"q"  "quit pager"  [keep-going: false]
        #"h"  "Help"  [menu/show menu/ask]
      ]
    ]

    do: func [string /local line]  [
        content: parse/all string "^/"
        curr-line: 1

        keep-going: true
        while [keep-going] [
            print rejoin header
            for line curr-line (curr-line + view-lines) 1 [
                if found? pick content line [print pick content line]
                a: line
            ]
            if ((perc: to-integer (100 * (a / length? content))) > 100) [
	       perc: 100
	    ]
            prin rejoin footer
            menu/ask
        ]
        print " "
        exit
    ]

]

] ; if error? ...

;
; End of copied over ...
;

; use works here, because the script just runs through and exits
use [ file data ind depth line-count pretty-file emit indent space
non-special all line ind ] [

default-indentation: "3"

file: copy ""
data: copy ""
line: copy ""

depth: next-depth: 0
line-count: 0

pretty-file: copy []
pretty-file: make string! 10000

emit: func [data] [if not none? data [append line data]]
indent: func [depth[integer!]] [insert/dup head line "^-" depth] 

space: charset reduce [tab " "]
non-special: complement charset ";[](){^/^""
all: complement charset ""

while [true] [
   file: ask "File to pretty print: "
   if not error? try [ data: read to-file file ] [
      break
   ]
   prin ["^/File not found, current dir is: " what-dir]
   print "^/Please try again^/"
]

ind: to-integer prompt "Spaces per level:     " default-indentation

parse/all data [  
   any space 
   some [        
      copy part any non-special (emit part last-rule: 'non-special)
      some [ 
         "[" (emit "[" if last-rule = 'ret [++ depth] ++ next-depth last-rule: 'par-op) |
         "]" (emit "]" if last-rule = 'ret [-- depth] -- next-depth last-rule: 'par-clos) |
         "(" (emit "(" if last-rule = 'ret [++ depth] ++ next-depth last-rule: 'par-op) |
         ")" (emit ")" if last-rule = 'ret [-- depth] -- next-depth last-rule: 'par-clos) |
         "{" copy part thru "}" (emit "{" emit part last-rule: 'str) | ; }
         ";" copy part to newline (emit ";" emit part last-rule: 'comment) |
         "^"" copy part thru "^"" (emit "^"" emit part last-rule: 'str)  | 
         "^/" any space (
	    trim/tail line
	    emit "^/" 
            if not last-rule = 'ret [ indent depth ] 
            append pretty-file line
            line: copy ""
            depth: next-depth
            last-rule: 'ret ) 
         ; | "^^" copy part thru 1 all (emit "^^" emit part last-rule 'esc) skip 
      ]
   ]
]
    

pretty-file: detab/size pretty-file ind
pager/do pretty-file

file: to-file prompt "File to save to: " rejoin [ to-string file ".pr" ]

write file pretty-file

]