Qtask Markup Language Editor

    Purpose: {
        This program implements a client-side editor for the Qtask Markup Language.
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    File: %qml-ed.r
    License: {
        Copyright (c) 2006 Prolific Publishing, Inc.

        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.
    } 
    Date: 5-Sep-2006
    Version: 1.9.1 ; majorv.minorv.status
                   ; status: 0: unfinished; 1: testing; 2: stable
    History: [
        21-Aug-2006 1.1.0 "History start"
        22-Aug-2006 1.2.0 "First version"
        22-Aug-2006 1.3.0 "Added area action to set is-modified?"
        28-Aug-2006 1.4.0 "Added check on saving about overwriting files"
        28-Aug-2006 1.5.0 "Added edit buttons"
        28-Aug-2006 1.6.1 "Finished edit buttons"
         4-Sep-2006 1.7.1 "Added PDF output"
         5-Sep-2006 1.8.1 "Ctrl-S saves, fixed problem with inverted highlight"
         5-Sep-2006 1.9.1 "Fixed bug with overwrite check if no suffix was given"
    ]

\note TODO

#Add scrollbar

/note

===Introduction

Qtask introduced the Qtask Markup Language for the creation of documents; this
markup language can be used to create documents inside Qtask (usually, Qwikis).
This program allows the creation of HTML documents directly from the client,
without the need for Internet connectivity to reach Qtask. This allows using the
QML language in many more cases.

\note Developer documentation

This is developer documentation, not user documentation. Please look at the
program's help for info about using the program.

/note

===Overview

The program is very simple. We include the code for QML and the XHTML emitter;
then we define a number of functions used in the GUI actions; then we show a
simple GUI that allows editing the QML text.

If the window is closed, we check if the document was modified and then exit (see
|-utility-functions-|).

    -main-:
    #include %qml-base.r
    #include %xhtml-emitter.r
    #include %pdf-emitter.r

    -functions-

    -change-event-func-

    view/title center-face layout [
        across
        -menu-buttons-
        -edit-buttons-
        a: area 700x500 wrap with [deflag-face self tabbed] [
            is-modified?: a/dirty?
        ]
        do [focus a]
    ] "Qtask Markup Language Editor"
    check-modified "Exiting the program" [quit]

===Menu buttons

The first row of buttons allows loading and saving files and gives access to the program
help.

    -menu-buttons-:
    btn "New" [new-doc]
    btn "Load QML" [load-qml]
    btn #"^S" "Save QML" [save-qml]
    btn "Save HTML" [save-html]
    btn "Save PDF" [save-pdf]
    btn-enter "Preview" [show-preview]
    pad 15
    btn "Help" [browse %help.html]
    btn "QML Ref." [browse %qmlref.html]
    btn "Online Help" [-browse-qtask-help-]
    pad 15
    btn-cancel "Quit" [quit?] return

---Browse online help on Qtask

    -browse-qtask-help-:
    browse http://www.qtask.com/help.cgi?qwikititle=Help%20-%2010%20-%20Qwiki&qWikiRef=header-12

===Edit buttons

The second row of buttons offers a number of shortcuts for inserting QML commands into the
text. This is currently not yet implemented.

    -edit-buttons-:
    btn bold "B" [make-bold]
    btn italic "I" [make-italic]
    pad 9
    btn "Num" [toggle-num]
    btn "Bull" [toggle-bullet]
    btn ">>" [inc-indent]
    btn "<<" [dec-indent]
    btn "1. H" [make-h1]
    btn "1.1 SH" [make-h2]
    btn "1.1.1 SH" [make-h3]
    pad 9
    btn "Just" [justify-para]
    btn "Left" [leftalign-para]
    btn "Cent" [center-para]
    btn "Right" [rightalign-para]
    btn "Comm" [comment-text]
    pad 9
    btn "Image" [insert-image] return

===Definition of functions

    -functions-:
    -utility-functions-
    -file-functions-
    -edit-functions-

---Load and save functions

The |quit?| function checks if the current document has been modified (see |-utility-functions-|),
and quits the program.

    -file-functions-:
    quit?: does [
        check-modified/cancel "Exiting the program" [quit] "Don't quit"
    ]

|new-doc| creates a new document, after checking if the doc has been modified.
See |-utility-functions-| for |set-area|.

    -file-functions-:
    new-doc: does [
        check-modified/cancel "Creating a new document" [
            current-file-name: none
            is-modified?: no
            set-area copy ""
        ] "Keep doc"
    ]

We're going to keep a global |current-file-name| to be used when saving etc.
As you have seen |new-doc| resets it to |none|.

    -file-functions-:
    current-file-name: none

The |show-preview| function creates a preview of the document and shows it in the
browser. See |-utility-functions-| for |gen-doc|.

    -file-functions-:
    show-preview: does [
        attempt [
            write %preview.html gen-doc
            browse %preview.html
        ]
    ]

Before loading a new file, we check if the current document has been modified.
Then we use |request-file| to get the file name and |read| it. If there's an
error while loading, an alert is shown. See |-utility-functions-| for |form-error|
and |set-area|.

    -file-functions-:
    load-qml: has [file text] [
        check-modified "Loading another document" [
            if file: request-file/only/title "Load QML file" "Load" [
                either error? text: try [read file] [
                    alert join "Error loading file: " form-error disarm text
                ] [
                    current-file-name: file
                    is-modified?: no
                    set-area text
                ]
            ]
        ]
    ]

When saving, we ask the user for a file name (user can cancel at this point).
We add the |%.qml| suffix if not present, and write the text on the given file.
An alert is shown in case of error. The function returns |true| if the file was
saved successfully (and sets |current-file-name| and |is-modified?|), otherwise
returns |false|.

    -file-functions-:
    save-qml: has [file err] [
        if -request-file-name- [
            either error? err: try [write file a/text none] [
                alert join "Error saving file: " form-error disarm err
                false
            ] [
                current-file-name: file
                is-modified?: no
                true
            ]
        ]
    ]

When creating the HTML output file, we ask the user for a file name, using the current
file name as default; we add a |%.html| suffix if not present. After saving the file
successfully, we check if we need to copy other needed files (i.e. CSS and image files).

    -file-functions-:
    save-html: has [file err] [
        if current-file-name [
            file: either file: find/last current-file-name %. [
                copy/part head file file
            ] [
                current-file-name
            ]
        ]
        if -request-file-name2- [
            either error? err: try [write file gen-doc none] [
                alert join "Error saving file: " form-error disarm err
            ] [
                check-required-files file
            ]
        ]
    ]

When creating the PDF output file, we ask the user for a file name, using the current
file name as default; we add a |%.pdf| suffix if not present.

    -file-functions-:
    save-pdf: has [file err] [
        if current-file-name [
            file: either file: find/last current-file-name %. [
                copy/part head file file
            ] [
                current-file-name
            ]
        ]
        if -request-file-name3- [
            if error? err: try [write file gen-pdfdoc none] [
                print form-error/all disarm err
                alert join "Error saving file: " form-error disarm err
            ]
        ]
    ]

+++the user gives a file name

Request a file name to save the QML text:

    -request-file-name-:
    file: req-save "Save QML file" any [current-file-name %"New QML document"] %.qml

+++the user gives a file name

Request a file name to save the HTML output:

    -request-file-name2-:
    file: req-save "Save HTML file" any [file %"New HTML document"] %.html

+++the user gives a file name

Request a file name to save the PDF output:

    -request-file-name3-:
    file: req-save "Save PDF file" any [file %"New PDF document"] %.pdf

---Edit functions

Edit functions are called by the edit button; they are basically shortcuts to insert
QML commands in the text.

The |make-bold| and |make-italic| functions make the highlighted text bold or italic
(respectively).

    -edit-functions-:
    make-bold: does [
        with-caret [
            ; highlighted text
            highlight-start: insert highlight-start "=b "
            highlight-end: skip highlight-end 3
            insert highlight-end "=b."
        ] [
            ; no text highlighted
            insert caret "=b =b."
            caret: skip caret 3
        ]
    ]
    make-italic: does [
        with-caret [
            ; highlighted text
            highlight-start: insert highlight-start "=i "
            highlight-end: skip highlight-end 3
            insert highlight-end "=i."
        ] [
            ; no text highlighted
            insert caret "=i =i."
            caret: skip caret 3
        ]
    ]

The |toggle-num| and |toggle-bullet| functions make the current paragraph numbered or
bulleted (respectively), or make it a normal paragraph again. They use the |toggle| function,
which in turn uses the |replace-at-line-start|
function defined below.

    -edit-functions-:
    toggle: func [cmd repl] [
        replace-at-line-start compose [(cmd) "" (repl) (cmd) "" (cmd)]
    ]
    toggle-num: does [
        toggle "=# " "=* "
    ]
    toggle-bullet: does [
        toggle "=* " "=# "
    ]

The |replace-at-line-start| function takes a list of strings, in pairs. If the start of the line where the
caret is (or the highlight starts) begins with the first string in the pair, it is replaced by the
second string in the pair. The function uses the |replace-cmd| function defined below, as well as
the |start-of-line| function defined in |-utility-functions-|.
Note that we need to use indexes to reset the caret and highlight positions to avoid problems when
a removal makes one of them go past tail.

    -edit-functions-:
    replace-at-line-start: func [list /local pos] [
        with-caret [
            pos: start-of-line highlight-start
            highlight-start: index? highlight-start
            highlight-end: index? highlight-end
            pos: replace-cmd pos list
            highlight-start: at head focal-face/text highlight-start + pos
            caret: highlight-end: at head focal-face/text highlight-end + pos
        ] [
            pos: start-of-line caret
            caret: index? caret
            pos: replace-cmd pos list
            caret: at head focal-face/text caret + pos
        ]
    ]

The |replace-cmd| function takes a position in a string, and a list of pairs of strings.
If the text at the given position matches one of the strings that appear first in the pairs,
it is replaced by the second string in that pair. The function returns the offset that the replacement
introduces into the string, i.e. the difference between the length of the new text and the
length of the original text.

    -edit-functions-:
    replace-cmd: func [pos list /local rule mark act] [
        rule: clear [ ]
        foreach [cmd repl] list [
            act: make paren! compose [
                change/part pos (repl) mark
                return (subtract length? repl length? cmd)
            ]
            append rule compose/only [
                (if not empty? cmd [cmd]) mark: (act)
                |
            ]
        ]
        remove back tail rule
        parse pos rule
        0
    ]

The |inc-indent| and |dec-indent| function increase and decrease indentation for a paragraph.

    -edit-functions-:
    inc-indent: does [
        replace-at-line-start [
            "=>" "=>>"
            "=* " "=** "
            "=# " "=## "
            "=** " "=** "
            "=## " "=## "
            "" "=> "
        ]
    ]
    dec-indent: does [
        replace-at-line-start [
            "=>>" "=>"
            "=** " "=* "
            "=## " "=# "
            "=> " ""
        ]
    ]

The |make-h1|, |make-h2| and |make-h3| functions make a paragraph into a header.
They call the |make-h| function. (Note that it works because order of elements in
the list for |replace-at-line-start|  is important; one of the three commands will
always appear twice, but the first has precedence, so we get the intended behavior.)

    -edit-functions-:
    make-h: func [cmd] [
        replace-at-line-start compose [
            (cmd) ""
            "=1 " (cmd)
            "=1' " (cmd)
            "=2 " (cmd)
            "=2' " (cmd)
            "=3 " (cmd)
            "=3' " (cmd)
            "=4 " (cmd)
            "=5 " (cmd)
            "=6 " (cmd)
            "" (cmd)
        ]
    ]
    make-h1: does [make-h "=1 "]
    make-h2: does [make-h "=2 "]
    make-h3: does [make-h "=3 "]

The |justify-para|, |leftalign-para|, |center-para| and |rightalign-para| functions
set the justification of a paragraph or a set of paragraphs. They use the |set-just|
function. If there is some text highlighted, it justifies all the paragraphs selected;
otherwise it just changes the justification of the line with the caret.

    -edit-functions-:
    set-just: func [para block /local pos] [
        with-caret [
            highlight-start: start-of-line highlight-start
            highlight-end: any [find/tail highlight-end newline tail highlight-end]
            highlight-start: insert insert highlight-start block newline
            highlight-end: skip highlight-end 1 + length? block
            insert insert highlight-end block ".^/"
            highlight-end: back highlight-end
        ] [
            pos: start-of-line caret
            caret: index? caret
            pos: replace-cmd pos compose [
                "=j " (para)
                "=l " (para)
                "=c " (para)
                "=r " (para)
                "" (para)
            ]
            caret: at head focal-face/text caret + pos
        ]
    ]
    justify-para: does [set-just "=j " "=justify"]
    leftalign-para: does [set-just "=l " "=left"]
    center-para: does [set-just "=c " "=center"]
    rightalign-para: does [set-just "=r " "=right"]

The |comment-text| function comments out a part of the text; if no text is selected,
the current paragraph is commented out; otherwise, the selected text is commented out.

    -edit-functions-:
    comment-text: does [
        with-caret [
            highlight-start: insert highlight-start "=comment "
            highlight-end: skip highlight-end 9
            insert highlight-end "=comment."
        ] [
            pos: start-of-line caret
            caret: index? caret
            pos: replace-cmd pos [
                "=' " ""
                "" "=' "
            ]
            caret: at head focal-face/text caret + pos
        ]
    ]

The |insert-image| function inserts an image at the curret caret position; if
some text is selected, the selection is replaced by the image. We need to save
and restore the caret information because it gets changed by |request-text|.

    -edit-functions-:
    saved-words: bind [focal-face caret highlight-start highlight-end] system/view
    insert-image: has [url saved-vals] [
        saved-vals: reduce saved-words
        url: request-text/title/default "Insert image URL" "http://"
        set saved-words saved-vals
        with-caret [
            highlight-end: change/part highlight-start reduce ["=image[" url "] "] highlight-end
        ] [
            caret: insert caret reduce ["=image[" url "] "]
        ]
    ]

---Utility functions

A function we used a couple times is |check-modified|. If the current document
has been modified (and not saved), it offers the option to save it to the user. For this
reason we keep a global |is-modified?| flag.

The function takes as arguments some text describing the action that would destroy
the current changes, the code for the action itself (i.e. loading a new file), and
optionally (|/cancel| refinement) the text for a cancel option. Note: we are using |switch| 
on the result of |request| because the third option (if present) returns |none|, which means something different
from |false| (second option). We're using |reduce| instead of using the |#[true]| and |#[false]|
notations because Encap doesn't correctly handle them and we want to be able to encap this
program.

    -utility-functions-:
    is-modified?: no
    check-modified: func [text action /cancel cancel-text] [
        either is-modified? [
            switch request compose [
                (rejoin ["Document was not saved. " text " means losing changes."])
                "Save" "Don't save" (any [cancel-text [ ]])
            ] reduce [
                true [
                    if save-qml action
                ]
                false [
                    do action
                ]
            ]
        ] [
            do action
        ]
    ]

We also used the |set-area| functions to set the text inside the |area| style.

    -utility-functions-:
    set-area: func [text] [
        a/text: text
        a/line-list: none
        a/para/scroll: 0x0
        system/view/caret: text
        focus a
    ]

|form-error| takes a disarmed error object and creates an error
message. With the |/all| refinement, the result is the same as would
be produced by the REBOL console.

    -utility-functions-:
    form-error: func [
        "Forms an error message"
        errobj [object!] "Disarmed error"
        /all "Use the same format as the REBOL console"
        
        /local errtype text
    ] [
        errtype: get in system/error get in errobj 'type
        text: get in errtype get in errobj 'id
        if block? text [text: reform bind/copy text in errobj 'self]
        either all [
            rejoin [
                "** " get in errtype 'type ": " text newline
                either get in errobj 'where [join "** Where: " [mold get in errobj 'where newline]] [""]
                either get in errobj 'near [join "** Near: " [mold/only get in errobj 'near newline]] [""]
            ]
        ] [
            text
        ]
    ]

The |gen-doc| function generates the XHTML output from the QML text in the
|area|.

    -utility-functions-:
    gen-doc: does [
        replace 
            read %template.html
            "$content"
            xhtml-emitter/generate qml-scanner/scan-doc a/text
    ]

The |gen-pdfdoc| function generates the PDF output from the QML text in the
|area|.

    -utility-functions-:
    gen-pdfdoc: has [w r] [
        w: flash "Generating PDF document... please wait..."
        r: pdf-emitter/generate qml-scanner/scan-doc a/text
        unview/only w
        r
    ]

|map| is a useful function to apply a function to all the values in a
series. This is a simplified version.

    -utility-functions-:
    map: func [series code] [
        code: func [value] code
        forall series [series/1: code series/1]
        series
    ]

The |check-required-files| function copies the needed CSS and image files to the
directory of the HTML output file. The argument is the HTML file name, so that
|first split-path dest-dir| gives the actual destination directory.

    -utility-functions-:
    required-files: append [
        %qwiki.css %burbank.css
    ] map read %images/ [join %images/ value]
    check-required-files: func [dest-dir] [
        dest-dir: first split-path dest-dir
        foreach file required-files [
            if not exists? dest-dir/:file [
                make-dir/deep first split-path dest-dir/:file
                write/binary dest-dir/:file read/binary file
            ]
        ]
    ]

The |req-save| function requests a file name for saving; it returns |none| if the user
cancels the save operation, otherwise returns the file name; it checks if the file exists
already and lets the user decide if to overwrite it or not too.

    -utility-functions-:
    req-save: func [title default suffix /local file] [
        forever [
            either file: request-file/only/save/title/file title "Save" default [
                if not suffix? file [
                    file: join file suffix
                ]
                either exists? file [
                    if request ["File exists. Do you want to overwrite it?" "Overwrite" "Chg. name"] [
                        return file
                    ]
                ] [
                    return file
                ]
            ] [
                return none
            ]
        ]
    ]

The |with-caret| function evaluates the first code block if there is some text highlighted,
otherwise evaluates the second code block if |system/view/caret| is not |none|; the code
is bound to |system/view| before evaluation. (The body of |with-caret| is also bound to |system/view|
for convenience.)

    -utility-functions-:
    with-caret: func [high-code code] bind [
        either highlight-start [
            if greater? index? highlight-start index? highlight-end [
                set [highlight-start highlight-end]
                    reduce [highlight-end highlight-start]
            ]
            do bind high-code system/view
            is-modified?: yes
            show a
        ] [
            if caret [
                do bind code system/view
                is-modified?: yes
                show a
            ]
        ]
    ] system/view

The |start-of-line| functions finds the beginning of the line containing the given position.

    -utility-functions-:
    start-of-line: func [pos /local nl] [
        either nl: find/reverse pos newline [next nl] [head pos]
    ]

===Change the default event function to avoid unwanted unfocusing

REBOL/View's default event function unfocuses the area face if it is dirty (i.e. text
has been changed) and the user clicks somewhere else (i.e. on a button). We don't want
this to happen (the edit buttons won't work otherwise).

    -change-event-func-:
    system/view/screen-face/feel/event-funcs/1: func [face event] [
        face: system/view/focal-face
        if all [
            face
            event/type = 'down
            not within? event/offset win-offset? face face/size
            face/dirty?
        ] [
            if flag-face? face on-unfocus [
                do-face face none
                face/dirty?: none
            ]
        ]
        event
    ]