REBOL [
    Title: "REBOL Standard Document Formatter"
    Date: 25-May-2001
    Version: 0.9.0
    File: %make-doc.r
    Author: "Carl Sassenrath"
    Purpose: {(See MakeDoc2 for the latest version.)
Converts very simple text file format into other
document formats (such as HTML) with good titles, table
of contents, section headers, indented fixed-spaced
examples, bullets and definitons.  Does the formatting
so you can focus on the hard part: the words.
}
    Email: carl@rebol.com
    Note: {
^-^-The input file scanner and the output format generator
^-^-are now independent.  The input file is scanned into
^-^-an internal block that can be used to generate different
^-^-target output formats such as HTML, text, PDF, helpfile,
^-^-etc. Only HTML generator is provided at this time.
^-}
    library: [
        level: 'advanced 
        platform: 'all
        type: 'tool 
        domain: [file-handling markup text-processing] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

;-- Scan document into the internal format -----------------------------------
scan-ctx: context [

    out: []

    emit: func ['word d1] [
        if string? d1 [trim/tail d1]
        repend out [word d1]
    ]

    emit-section: func [num] [emit (to-word join "sect" num) text title: true]

    as-file: func [str] [to-file trim str]

    insert-file: func [str file /local text] [
        if file/1 = "%" [remove file]
        if not exists? file [alert reform ["Missing include file:" file] exit]
        text: read file
        insert/part str text any [find text "^/###" tail text] 
    ]

    space: charset " ^-"
    chars: complement nochar: charset " ^-^/"
    text: none
    para: none
    title: none

    ;--- Text Format Language:
    rules: [some parts]

    parts: [ ;here: (print here)

        newline |

        ;--Document sections:
        "***" text-line (if title [alert reform ["Duplicate title:" text]] emit title text) |
        ["===" | "-1-"] TEXT-LINE (EMIT-SECTION 1) |
        ["---" | "-2-"] text-line (emit-section 2) |
        ["+++" | "-3-"] text-line (emit-section 3) |
        ["..." | "-4-"] text-line (emit-section 4) |
        "###" to end (emit end none) |

        ;--Special common notations:
        ":" define opt newline (emit define reduce [text para]) |
        "*" paragraph opt newline (emit bullet para) |
        "#" paragraph opt newline (emit enum para) |
        ";" paragraph |  ; comment

        ;--Commands:
        "=image" image |
        "=url" some-chars copy para to newline newline (emit url reduce [text para]) |
        "=view" left? [some space copy text some chars | none] (emit view text) |
        "=include" some-chars here: (insert-file here as-file text) |
        "=file" some-chars (emit file as-file text) |
        "=options" some [
            spaces "no-indent" (emit option 'no-indent) |
            spaces "modern" (emit option 'modern)
        ] thru newline |
        "=toc" thru newline (emit toc none) |

        ;--Special sections:
        "\in" (emit indent-in none) |
        "/in" (emit indent-out none) |
        "\note" text-line (emit note-in text) |
        "/note" text-line (emit note-out none)|

        ;--Defaults:
        example (emit code trim/auto code) |
        paragraph (either title [emit para para][emit title title: para]) |
        skip
    ]

    spaces: [any space]
    some-chars: [some space copy text some chars]
    text-line: [copy text thru newline]
    paragraph: [copy para some [chars thru newline]]
    example:   [copy code some [indented | some newline indented]]
    indented:  [some space chars thru newline ]
    define:    [copy text to " -" 2 skip any space paragraph]

    left?: [some space "left" (left-flag: on) | none (left-flag: off)]

    image: [
        left? any space copy text some chars (
            text: as-file text
            either left-flag [emit image reduce [text 'left]][emit image text]
        ) 
    ]

    set 'scan-doc func [str] [
        clear out
        parse/all detab str rules
        copy out
    ]
]

;-- Generate HTML output ----------------------------------------------------
html-ctx: context [

    out: make string! 10000
    emit: func [data] [append out reduce data append out newline]

    sects: [0 0 0 0]

    fonts: context [
        title: 
        h1: 
        h2: 
        h3: 
        h4: 
        toc: 
        normal: 
        list: normal
        define: normal
        note: 
        url: 
    ]
    ef: 
    hfonts: [h1 h2 h3 h4]

    sect-num?: func [num /local n sn] [
        change at sects num n: sects/:num + 1
        change/dup at sects num + 1 0 4 - num
        sn: copy ""
        repeat n num [append sn join sects/:n "."]
        sn
    ]

    clear-sects: does [change/dup sects 0 4]

    emit-sect: func [num str /local sn] [
        if num <= 2 [
            if sects/1 > 0 [emit ]
            if num = 1 [emit 
] ] sn: sect-num? num emit [{}] emit ["" get in fonts hfonts/:num sn " " str ef ""] if num <= 2 [emit
] ] emit-toc: func [doc /local w] [ emit [
fonts/h1 "Contents" ef
] foreach [word text] doc [ if w: find [sect1 sect2 sect3 sect4] word [ sn: sect-num? w: index? w loop w - 1 * 8 [append out " "] emit [ {} either w = 1 [fonts/h2][fonts/normal] pick [ ""] w <= 2 sn " " text pick [ ""] w <= 2 ef
] ] ] emit
clear-sects ] emit-item: func [doc 'item tag] [ if doc/-2 <> item [emit tag] emit [
  • fonts/list doc/2 ef] if doc/3 <> item [emit head insert copy tag #"/"] ] emit-def: func [doc] [ if doc/-2 <> 'define [ emit {} ] emit [ ] if doc/3 <> 'define [emit {
    " " fonts/define any [doc/2/1 " "] ef fonts/normal any [doc/2/2 " "] ef

    }] ] emit-note: func [text] [ emit [ {
    } fonts/note text ef {
    } ] ] emit-end: does [ ; change this for your own docs emit [


    "Copyright REBOL Technologies. All Rights Reserved."
    "REBOL and the REBOL logo are trademarks of REBOL Technologies."
    "Formatted with Make-Doc " system/script/header/version " on " now/date " at " now/time

    ] ] html-codes: ["&" "&" "<" "<" ">" ">"] escape-html: func [text][ foreach [from to] html-codes [replace/all text from to] text ] emit-code: func [text] [ emit [

     escape-html text 
    ] ] set 'gen-html func [doc] [ ;foreach [w t] doc [print w] halt emit if doc/1 = 'title [emit [ doc/2 ]] emit if doc/1 = 'title [ emit [

    fonts/title doc/2 ef

    ] doc: skip doc 2 ] if doc/1 = 'code [ emit [
     fonts/normal  doc/2  ef 
    ] doc: skip doc 2 ] if not find head doc 'toc [emit-toc doc] forskip doc 2 [ switch/default doc/1 [ para [emit [fonts/normal doc/2 ef

    ]] code [emit-code doc/2] enum [emit-item doc enum

      ] bullet [emit-item doc bullet
        ] define [emit-def doc] sect1 [emit-sect 1 doc/2] sect2 [emit-sect 2 doc/2] sect3 [emit-sect 3 doc/2] sect4 [emit-sect 4 doc/2] indent-in [emit
        ] indent-out [emit
        ] note-in [emit-note doc/2] note-out [emit {

    }] image [] view [] end [emit-end] toc [] ][print doc/1 halt] ] emit {} write %test-out.html out browse %test-out.html ] ] ;-- Read file... ;system/script/args: %makespec.txt if not file: system/script/args [ file: request-file if any [not file not file: file/1] [quit] ] if empty? file [quit] if not exists? file [alert reform ["Error:" file "does not exist"] quit] gen-html scan-doc read file