REBOL [
    Title: "Export Messages"
    Purpose: "GUI Front end to mime-export-forwarded-messages"
    Author: "Brett Handley"
    Date: 23-Jan-2003
    Rights: {Copyright © Brett Handley 2003

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.}

]

; Supporting code
do load-thru http://www.codeconscious.com/rebsite/rebol-library/mime-views.r ; loads mime-model.r as well.

documentation-reference: http://www.codeconscious.com/outlook-express/exporting-from-outlook-express.html

msg-spec: target-dir: none

files: none
message-model: none
read-error: none
part-list: none
last-spec: none
main-face-size: system/view/screen-face/size - 75x75

ua-browse-doco: does [browse documentation-reference]

ui-main: layout [
    style label label 110x25
    style field field 390x25
    style button button 110x25

    backdrop effect [gradient 1x1 220.220.255 0.0.172]
    size main-face-size below

    banner "Export Messages"

    text {Give this program an email of forwarded emails and it saves out each of the forwarded emails. It will name each of them consecutively as using a pattern you supply. This program was described on my website. Click on the url below to view the web page which explains this in more detail.}

    text white 500x25 to-string documentation-reference [ua-browse-doco]

    text {Note: Rebol runs in "sandbox" so if you want to process a file outside of that sandbox you will receive a warning titled "Security check". Make a choice to proceed.}
    across

    text "Using this program means you agree to the rights terms - click to see them" white [ua-view-rights]
    return

    h3 "1) Select your message file." return
    label "Message file:"
    msg-spec: field [ua-change-file]
    button "Select file" [ua-select-file]
    return

    h3 "2) Read the message file." return
    label { }
    button 200x25 "Read message now" [ua-read-messages]
    read-status: label 185
    button "View" [ua-view-parts]
    return

    h3 "3) Enter your target directory." return
    label "Target directory:" target-dir: field [ua-change-directory]
    ;       button "Select directory" [ua-select-directory] ; I need a request-dir
    return

    h3 "4) Decide on the filename pattern" return
    label "File name pattern:" name-pattern: field 100 "msg-*.eml" [ua-change-pattern]
    example-files: label 400 return

    h3 "5) Save the messages" return
    label { }
    button 250x25 "Save messages now" [ua-save-messages]
    return

    at (main-face-size - 255x40)
    text 200x18 copy/part system/script/header/rights (
        find system/script/header/rights newline
    ) silver [ua-view-rights]

]

ua-view-rights: does [
    view/new center-face layout [
        backdrop effect [gradient 1x1 220.220.255 0.0.172]
        text as-is system/script/header/rights
    ]
]

ua-change-file: does [reset-dependents-for-new-file]

ua-select-file: does [
    files: request-file
    if all [files not empty? files] [
        msg-spec/text: to-string to-local-file first files show msg-spec
        last-spec: none
        reset-dependents-for-new-file
    ]
]

ua-read-messages: does [
    part-list: none
    read-error: none

    if empty? trim msg-spec/text [make error! "No file specified."]

    if error? try [message-model: mime-structure? read to-rebol-file msg-spec/text] [
        make error! "Could not process file."
    ]
    if not message-model [make error! "May not be a MIME message."]
    if not mime-multipart? message-model ["Expecting a MULTIPART message."]

    use [message message-count other-count] [
        message-count: other-count: 0
        for part-number 1 length? message-model/content 1 [
            message: message-model/content/:part-number
            either mime-is-rfc822? message [message-count: message-count + 1
            ] [other-count: other-count + 1]
        ]
        either greater? other-count 0 [
            read-status/text: join "" [message-count " messages " other-count " other"]
            read-status/font/color: orange
        ] [
            read-status/text: join "" [message-count " messages "]
            read-status/font/color: green
        ]
        show read-status
    ]

]

ua-view-parts: does [if message-model [show-message-parts message-model]]

ua-change-directory: does [check-output-directory]

ua-change-pattern: does [
    check-name-pattern
    example-files/text: rejoin [
        "Files will be named: "
        replace copy name-pattern/text "*" "1"
        ", "
        replace copy name-pattern/text "*" "2"
        ", ..."
    ]
    show example-files
]

ua-save-messages: has [output-dir message message-count prefix postfix] [
    check-name-pattern
    prefix: copy/part trim name-pattern/text find name-pattern/text #"*"
    postfix: copy next find/last name-pattern/text #"*"
    if not message-model [make error! "No message to process."]
    check-output-directory
    output-dir: dirize to-rebol-file target-dir/text
    if not exists? output-dir [make error! "Target directory does not exist - nothing done."]

    if not request/confirm rejoin [
        {About to write the messages to } target-dir/text {. }
        example-files/text
        { Proceed?}] [return]

    message-count: 0
    for i 1 length? message-model/content 1 [
        if mime-is-rfc822? message: message-model/content/:i [
            message-count: message-count + 1
            write join output-dir [prefix message-count postfix] message/content
        ]
    ]
    alert join to-string message-count " messages have been written."
]

check-output-directory: does [
    if empty? trim target-dir/text [make error! "Target directory is missing."]
    if error? try [target-dir/text: to-string to-local-file dirize to-rebol-file target-dir/text] [
        make error! "Please enter a valid directory specification."
    ]
    show target-dir
]

check-name-pattern: does [
    if empty? trim name-pattern/text [make error! "File name pattern is missing."]
    if not all [
        find name-pattern/text #"*"
        equal? find name-pattern/text #"*" find/last name-pattern/text #"*"
    ] [make error! "Use * to indicate counter. Example pattern msg-*.eml"]
]

reset-dependents-for-new-file: does [
    if all [last-spec equal? last-spec msg-spec/text] [RETURN]
    last-spec: msg-spec/text
    message-model: none
    read-error: none
    clear read-status/text show read-status
    part-list: none

    clear target-dir/text show target-dir
]

ua-change-pattern
view/new center-face ui-main

while [error? set/any 'result try [wait []]] [
    error: disarm result
    if block? msg: get in get in system/error error/type error/id [
        msg: bind/copy msg in error 'self
    ]
    alert reform msg
]