REBOL [
Title: "Site"
Date: 3-Jul-2002
Name: Site
Version: 1.0.0
File: %Site.r
Author: "Andrew Martin"
Purpose: {Site dialect. Creates web sites from plain text, etc.
I used it create my own site automatically.
}
Email: Al.Bri@xtra.co.nz
Web: http://valley.150m.com
Category: [util web script markup 5]
]
Site: make object! [
Site: none
Values: none
Resource: function [Block [block!] File [file!]][Path][
Path: %./
until [
if found? find Block File [return join Path File]
Path: join Path %../
none? Block: Block/..
]
none
]
Page!: make object! [
Title: string!
File: file!
Block: block!
Location: func [File [file!]][
Resource Block File
]
Body-Attributes: compose [
body/bgcolor/text/link/vlink/alink
(mold #FFFFFC) (mold #000000) (mold #CC0000) (mold #330099) (mold #FF3300)
]
Dialect: [
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "DTD/xhtml1-transitional.dtd">
html [
head [
title (Title)
]
(Body-Attributes) [(eText-Dialect)]
]
]
eText-Dialect: block!
Layout: func [eText [block!]][
eText-Dialect: eText
compose bind Body-Attributes 'self
compose/deep bind Dialect 'self
]
]
Default: make Page! [
;Dialect: append select copy Dialect 'Header [
;StyleSheet (Location %Stylesheet.css)
;]
]
Core: make Page! []
RecurseDirectory: function [Directory [file!]][Files Dialect][
Files: sort read Directory
Dialect: make block! length? Files
foreach File Files [
append Dialect either Directory? File [
use [Block][
Block: RecurseDirectory Directory/:File
Block/..: Dialect
reduce [File Block]
]
][
File
]
]
repend Dialect ['. Dialect '.. none] ; '. = self; '.. = parent
]
Generate: function [Remote [file! url!] Local [file!]][Block Directory][
Delete-Dir Remote
md Remote
Block: none
Core/File: join head remove back tail second split-path Local %.html
Directory: make object! [
File: none
Stack: make block! 10
Rule: [
any [
set File file! into [
(
Local: Local/:File
Remote: Remote/:File
push Stack Core/File
Core/File: join head remove back tail second split-path File %.html
md Remote
push/only Stack Block
)
Block: Rule
(
Local: clean-path join Local %../
Remote: clean-path join Remote %../
Block: pop Stack
Core/File: pop Stack
)
]
| set File file! (
any [
if found? find/last File %.txt [
Page: Resource Block Extension File %.r
Page: any [
if not none? Page [
do join Local Page
]
if = Filename Core/File Filename File [
clone Core []
]
Default
]
Page/Block: Block
Page/Title: to-string Filename File
Page/File: Extension File %.html
write join Remote Page/File ML Page/Layout eText read Local/:File
write Remote/:File read Local/:File
]
if all [
found? find/last File %.r
not found? find Block Extension File %.txt
][
use [R Index] [
R: load/all Local/:File
if 'Rebol <> first R [
R: first R
]
either found? find second R ['eText] [
R: at R 3
do bind R 'File
][
if found? Index: find R first [Site:] [
change next Index Site
]
if found? Index: find R first [Values:] [
change next Index Values
]
save Remote/:File R
]
]
]
if any [
found? find/last File %.css
found? find/last File %.js
found? find/last File %.html
][
write Remote/:File read Local/:File
]
write/binary Remote/:File read/binary Local/:File
]
)
]
'. block!
'.. [block! | none!]
]
]
parse RecurseDirectory Local repend [Block:] [Directory/Rule 'end]
]
]