doc/2

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