REBOL [ Title: "REBOL Standard Document Formatter" Date: 25-May-2001 Version: 0.9.0 File: %make-doc.r Author: "Carl Sassenrath" Purpose: {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 Category: [file markup text util 4] 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. ^-} ] ;-- 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