Rebol [
    Author: "Robert M. Münch"
    Title: "Wikipedia-On-The-Go"
    Version: 1.0.0
    Date: 29-Jan-2006
    Info: {Entry for the Rebol programming contest 2006.}

if system/product == 'Link [
    alert "This program requires Rebol View 1.3 or above. Pleas start through: open with... or öffnen mit..."

;--- general setup for debugging
; link-root: first split-path first split-path system/script/path
; do link-root/framework/anamonitor300.r

;--- Initialization
wiki-dir: %_wikipedia/
if not exists? wiki-dir [make-dir wiki-dir]

scroll-panel-vert: func [pnl bar][
    pnl/pane/offset/y: negate bar/data * (max 0 pnl/pane/size/y - pnl/size/y)
  show pnl

;--- Rich-Text Rendering
set-face-style: func [face style' /c colors'] [
    face/font: make face/font [
        style: either block? style [union style style'] [style']
        colors: none

    if c [
        face/font/colors: reduce colors'
        face/font/color: first face/font/colors

get-text-size: func [word][
    size-text make face [text: decode 1 word para: make para [origin: margin: 0x0 wrap?: false]]

add-output-face: func[word style /http link /local tmp strings right-side][
    ; skip empty stuff
    if any [none? word empty? word] [return]

    ; handle linefeeds but don't create a face
    if all [word = "^/"] ;  pos/x > 0]
    pos/y: pos/y + 20 ; second size-text make face [text: word]
    pos/x: 0

    ; break long text lines to fit face boundaries
    ; for this the text will be broken into blocks of strings
    strings: make block! []
    right-side: 15
    if (to-integer first get-text-size word) > (output-face/size/x - right-side) [
        tmp: copy ""
        foreach part parse word "" [
            either ((to-integer first get-text-size rejoin [tmp " " part]) + 3) > (output-face/size/x - right-side)
                ; handle face overflow
                append/only strings tmp

              ; continue next round
                tmp: part
                ; append to tmp string as long as possible
                repend tmp [" " part]

    ; if empty use input text otherwise add last round as well
    either empty? strings
        [append/only strings word]
        [append/only strings tmp]

    ; build richt-text face
    foreach part strings [
        insert tail output-face/pane make face [
        pane: none
        state: none
        offset: pos
        text: decode 1 part
        variants: make block! []

        switch style [
            link [
                ; wiki link is blue and hovered with red
            set-face-style/c self [underline] [blue red]
            feel: svv/vid-feel/hot
            action: func [face value][
                ; get clicked word and find out, which language to download
                sw: face/text

                foreach e wikilinks/user-data [
                    if found? find/any e join sw "*" [append variants e]

                        either (length? variants) = 1
                            [load-wikipedia create-wiki-word variants/1]
                                tmp: request-list "Select Wikipedia variant to download:" variants
                                load-wikipedia create-wiki-word tmp

                        ; update selection
                        downloaded/picked: rejoin [copy sw "_" get-face wlc]
                        show downloaded/update

                        wikilinks/picked: reduce [copy sw]
                        show wikilinks/update

            bold [
                set-face-style self [bold]

            italic [
                set-face-style self [italic]

            heading [
                set-face-style self [bold underline]
                self/font: make self/font [size: 16]

            http-link [
            set-face-style/c self [underline] [red blue]
            feel: svv/vid-feel/hot
            action: func [face value] reduce compose [
                'browse (link)

            sub-heading [
                set-face-style self [bold]
                self/font: make self/font [size: 14]

        para: make para [origin: margin: 0x0 wrap?: false]
        size: (size-text self) + 0x4

            if any [style = 'link style = 'italic style = 'bold][size: size + 2x0]

        if (pos/x + size/x) > (output-face/size/x - output-face/para/origin/x - output-face/para/margin/x) [
            pos/y: pos/y + size/y
            pos/x: 0
            offset: pos

                ; set height of output-pane face to new y-position
                output-face/size/y: pos/y

                    ; trim space at first position
                    text: trim/head text
        pos/x: pos/x + size/x ; + space/x

;--- Support Functions

;-- WikiWord and language identifier handling
create-wiki-word: func [taged-wikiword /local splitted joined lang][
    splitted: parse/all taged-wikiword "_"

    ; strip language identifier
    if all [(length? splitted) > 1 (length? last splitted) = 2][
        lang: copy last splitted
        remove back tail splitted

        ; set actual language to stripped language
        set-face wlc wlc/text: lang

    ; handle block structure
    joined: copy ""
    foreach e splitted [
        repend joined [e "_"]
    remove back tail joined
    return joined

;-- UTF handling
udata: [0 192 224 240 248 252]
decode: func [
    Decode a UTF-8 encoded string into UCS-k string,
    where k = 1, 2, 4.
    Encoded strings which originated from Latin-1
    can be decoded with k = 1, 2, or 4.
    Other encoded Latin-m (m > 1) strings can be
    decoded either with k = 2 or k = 4,
    but not with k = 1.
    k [integer!]
    xs [string!]
    /local m x c result [string!]
    result: make string! (length? xs) * k

    ; attemps required, because function sometimes fails and I don't know why
    while [not tail? xs][
        x: first xs
        either x < 128 [
            insert insert/dup tail result #"^@" k - 1 x
            m: 8 - length? find enbase/base to binary! x 2 #"0"
            x: x xor pick udata m
            attempt [loop m - 1 [x: 64 * x + (63 and first xs: next xs)]]
            result: tail result
            loop k - 1 [
                insert result to char! x and 255
                x: x and -256 / 256
            attempt [insert result to char! x]
        xs: next xs
    head result ; return as much as possible

time-it: use [last-time] [
  last-time: none
  duration: 0

  func [] [
    if last-time [duration: now/time/precise - last-time]
    last-time: now/time/precise
    return duration

;-- Wikipedia functions
get-wikipedia-word: func [word /local tmp wikipedia-link wikipedia-special][
    tmp: ""
    wikipedia-link: rejoin [ http:// lowercase copy get-face wlc ""]

    wikipedia-special: switch/default get-face wlc [
        "DE" ["Spezial:Export"]

    attempt [tmp: read/custom wikipedia-link reduce ['post  rejoin ["title=" wikipedia-special "&action=submit&pages=" word "&curonly=true"]]]
    return tmp

get-content: func [string start-pattern end-pattern /local start end][
    start: find/tail string start-pattern
    end: find string end-pattern

    return attempt [copy/part start ((index? end) - (index? start))]

load-wikipedia: func [entry /local-file /local filename page title text downloaded?][
    if any [none? entry empty? entry][return false]

    ; already downloaded?
    either local-file
            ; local-file so remove language tag
            filename: rejoin [wiki-dir entry %.txt]
            set-face wlc wlc/text: last parse entry "_"
            set-face searchword entry
            ; filename to save downloaded content to
            filename: rejoin [wiki-dir to-file entry "_" get-face wlc %.txt]

    either exists? filename
            text: decompress load filename
            downloaded?: false
            ;--set GUI info field
            set-face cdl entry
            page: get-wikipedia-word entry
            set-face dlt time-it
            set-face cdl ""

            downloaded?: true

            ;-- extract content
            title: get-content page <title> </title>
            text: get-content page <text xml:space="preserve"> </text>

    either none? text
            if not get-face adl [alert reform ["Entry for:" entry "not found."]] return false
            ;-- parse wiki-content, has to follow the download? handling because at the end of the parsing
            ; the wikilinks/user-data list is updated
            parse/all text wiki-rules

            ;-- store content if downloaded
            if downloaded? [
                save/all filename compress trim output
                fi: info? filename
                set-face lwas fi/size + to-integer get-face lwas

                ; update our downloaded list
                entry: rejoin [entry "_" get-face wlc]
                set-face searchword entry

                if not found? find downloaded/user-data entry [
                    append downloaded/user-data entry

                    set-face lwa rejoin ["Local Wikipedia Articles (" length? downloaded/user-data ") :"]

                ; hightlight just downloaded entry
                set-face downloaded entry

            ;-- update wikilinks list
            ; first merge wiki-links found in text than exclude allready downloaded wikiwords
            wikilinks/user-data: union wikilinks/user-data links
            wikilinks/user-data: sort exclude wikilinks/user-data downloaded/user-data

            save/all %_auto-dl-links.r wikilinks/user-data

            set-face wl rejoin ["Further Links to follow (" length? wikilinks/user-data ") :"]
            set-face rdl length? wikilinks/user-data

            set-face s1 0
            wikitext/pane output-face ; output is filled by parsing inside load-wikipedia
            scroll-panel-vert wikitext s1

            ; f1 is the filter field for the downloaded wikipedia article list
            filter-list f1
            filter-list f2 ; apply filter

            return true

;-- filter functions
filter-list: func [face /local list flist e][
    list: get face/user-data/1

    list/data: make block! []
    either empty? face/text
        [list/data: list/user-data]
        foreach e list/user-data [
            if found? find e face/text [insert list/data e]

    ; update textlist, we need to simulate a click on the "up-arrow"
    sort list/data
    list/sld/pane/2/action list/sld/pane/2 0
    show list/update

;--- Parse Rules
output: copy ""
output-tmp: copy ""
links: make block! []

space: size-text make face [para: make para [origin: margin: 0x0] text: " "]
pos: 0x0

handle-output-tmp: does [
    append output output-tmp
    add-output-face output-tmp 'text
    clear output-tmp

nochar: charset " ^-^/[]"
chars:  complement nochar

wiki-rules: [
    ; initializing done for each parsing
        ; clear txt holder
        clear output
        clear output-tmp
        clear links

        ; setup new rich-text-face
        clear output-face/pane
        output-face/pane: make block! []
        pos: 0x0

    some [
        "[[" copy word to "]]" 2 skip (


            if not none? word [
                ; replace special chars
                replace word "%28" "("
                replace word "%29" ")"

            ; check if link already present
            if all [
                not none? word
                not empty? word
                (length? parse/all word ":") = 1
                ; check to see if we have alternativ entries and use the first one
                word: first parse/all word "|"

                ; check to see if an anchor point is given and if just use the page
                word: first parse/all word "#"

                ; and add to output in all cases
                repend output ["[[" word "]]"]

                ; build rich-text face
                add-output-face word 'link

                ; add language identifier
                word: rejoin [decode 1 word "_" get-face wlc]

                ; add to found links of not already done
                if not found? find links word [append/only links word]
        | "#REDIRECT [[" copy word to "]]" 2 skip (load-wikipedia create-wiki-word word)
        | "'''" copy word to "'''" 3 skip (
            repend output ["'''" word "'''"] add-output-face word 'bold
        | "''" copy word to "''" 2 skip (
            repend output ["''" word "''"] add-output-face word 'italic
        | "{{" thru "}}"
        | "===" copy word to "===" 3 skip (
            repend output ["===" word "==="] add-output-face trim word 'sub-heading
        | "==" copy word to "==" 2 skip (
            repend output ["==" word "=="] add-output-face trim word 'heading
        | "[http://" copy link some chars [" " copy word to "]" 1 skip | to "]" 1 skip (word: link)] (
            repend output ["[http://" link " " word "]" ] add-output-face/http word 'http-link link
        | "&lt;!--" thru "&gt;"
        | "&lt;" (append output-tmp "<")
        | "&gt;" (append output-tmp ">")
        | "&quot" (append output-tmp {"})
        | "&amp;times;" (append output-tmp " x ")
        | "&amp;nbsp;"
        | "%28" (append output-tmp "(")
        | "%29" (append output-tmp ")")
        | newline (
            append output-tmp newline
        | c: skip (
            c: first c
            if all [
                (to-integer c) <> 226
                (to-integer c) <> 158
                (to-integer c) <> 156
                (to-integer c) <> 129
                (to-integer c) <> 128
            ][append output-tmp c]
    ] ; some

;--- Program GUI
sw: none ; searchword

main-gui: layout [
    style filter field 220x22 feel [
      engage: func [face act event] [
        switch act [
                down [
            either equal? face system/view/focal-face [unlight-text] [focus/no-show face]
            caret: offset-to-caret face event/offset
            show face
        over [
          if not-equal? caret offset-to-caret face event/offset [
            if not highlight-start [highlight-start: caret]
            highlight-end: caret: offset-to-caret face event/offset
            show face
        key [
            system/words/ctx-text/edit-text face event get in face 'action
            filter-list face

    style updateable-text-list text-list with [update-slider: does [sld/redrag lc / max 1 length? head lines]]

    at 10x10

    h1 "Wikipedia-On-The-Go Client" guide return
    at 10x50
    label "Search Word:" indent 10
    searchword: field "Ajax" 350x22 [
        hide wikihelp show wikitext

        ; get current searchword
        load-wikipedia create-wiki-word get-face searchword

    search: btn "Search" [
        hide wikihelp show wikitext

        ; get current searchword
        load-wikipedia create-wiki-word get-face searchword

    btn "Help" [
        either wikihelp/show?
            [hide wikihelp show wikitext]
            [hide wikitext show wikihelp]

    label "Language:" indent 28 wlc: choice 50x20 base-color "DE" "EN" "FR" "SV" "NL" "PL" "PT" "IT" "SP" "NO"

    label "Auto Download:" adl: check
    label "Random Download:" ardl: check
    indent 33 text "References To Download:" indent -5 rdl: text 150x20 return
    at 10x128
    bar 510


    at 10x130
    lwa: label 220x20 "Local Wikipedia Articles:"
    downloaded: text-list 220x500 [
        hide wikihelp show wikitext

        load-wikipedia/local-file copy first get-face downloaded

    at 240x130
    label "Wikipedia Text"
    wikitext: box 550x500 frame
    at 240x157
    wikihelp: area 550x500 wrap
    at 790x156
    s1: scroller 16x501 [scroll-panel-vert wikitext s1]

    at 815x130
    wl: label 220x20 "Referenced Links to follow:"
    wikilinks: text-list 220x500 [
        hide wikihelp show wikitext

        sw: copy first get-face wikilinks
        load-wikipedia create-wiki-word sw

        ; update selection
;       downloaded/picked: rejoin [copy sw "_" get-face wlc]
        set-face downloaded sw
        show downloaded/update

    ;-- Info fiels
    at 650x45
    label "Currently Downloading:" cdl: text 245x20
    at 690x60
    label "Download Time:" dlt: text 125x20 label "Seconds"
    at 614x75
    label "Local Wikipedia Article Sizes:" lwas: text 125x20 "0" label "Bytes"

    ; filter for downloaded wikipedia articles
    f1: filter 220x22 with [user-data: [downloaded]]
    indent 578
    ; filter for references to wikipedia articles
    f2: filter 220x22 with [user-data: [wikilinks]]

;   return
;   btn "Debug" [monitor]
;   btn "Halt" [halt]

;--- Main Program

; user-data stores the complete master list, data can contain filtered (shortend master list)
downloaded/user-data: make block! []
wikilinks/user-data: make block! []
if exists? %_auto-dl-links.r [
    wikilinks/user-data: load/all %_auto-dl-links.r

;-- initialize link lists
files: read wiki-dir
foreach entry files [
    fi: info? wiki-dir/:entry
    set-face lwas fi/size + to-integer get-face lwas

    ; add entry names to list
    if (suffix? entry) == %.txt [append downloaded/user-data to-string replace entry suffix? entry ""]
downloaded/data: sort downloaded/user-data
set-face lwa rejoin ["Local Wikipedia Articles (" length? downloaded/user-data ") :"]

wikilinks/data: sort wikilinks/user-data
set-face wl rejoin ["Referenced Links to follow (" length? wikilinks/user-data ") :"]
set-face rdl length? wikilinks/user-data

;-- Init GUI field
wlc/edge/color: base-color
wlc/edge/effect: none

; preset text in output face
wikitext/pane: make face [offset: 0x0 size: wikitext/size]
output-face: wikitext/pane
output-face/pane: make block! []

set-face wikihelp {The Wikipedia-On-The-Go client downloads the words you search for to your computersystems and stores the content for later off-line access. To use it just type in a search word and press RETURN or click the search button.

It supports different Wikipedia languages. Just select the language you want to access from the drop-downlist. All search requests will be directed to the selected language site. All downloaded articles are tagged with the language ID to be able to download different language versions. Language setting is changed with respect to the selected word.

On the left side you see the list of all your local (already downloaded) Wikipedia articles. On the right side you see a list of all found Wikiwords contained in the articles on the left side. Just click one to download it.

At the bottom you see two filter-fields for each list. Just start typing characters and you see the list being filtered in real-time. This is your fast search if you have downloaded many Wikipedia articles.

At the top right you see some information fields. These show the article currently being downloaded. The time it took to download the article and the size of all your local articles in bytes.

At the top left you have two check-boxes. The first one starts the autodownload feature. If enabled, the client crawls through the list on the right and downloads one entry after the other starting at the top. If you click the "Random Download" check-box, the download order is random. Wikiwords found in the downloaded articles are added to the list, so that you can perform a recursive download of Wikipedia articles.

To display HELP just click the help button. To hide help, just click the help button again, or search for a word or click any word to download.

;-- start main GUI
view/new main-gui

forever [
    ; handle GUI events
    wait 1

    ; do autodownload
    if get-face adl [
        index: 1
        if get-face ardl    [index: random length? wikilinks/user-data]
        adlsw: wikilinks/user-data/:index ; adlsw = auto-download-search-word

        either none? adlsw
            [set-face adl false set-face ardl false]
                if not load-wikipedia create-wiki-word adlsw [
                    ; not found, remove it from list
                    remove skip wikilinks/user-data index - 1

        save/all %_auto-dl-links.r wikilinks/user-data

;   if not viewed? main-gui [halt]
    if not viewed? main-gui [quit]