This program implements a client-side editor for the Qtask Markup Language.
Date | Version | Description | Author |
---|---|---|---|
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 |
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.
This is developer documentation, not user documentation. Please look at the program's help for info about using the program.
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〉).
〈Overview〉 ≡
#include %qml-base.r
#include %xhtml-emitter.r
#include %pdf-emitter.r
〈Definition of functions〉
〈Change the default event function to avoid unwanted unfocusing〉
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]
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 online help on Qtask〉]
pad 15
btn-cancel "Quit" [quit?] return
〈Browse online help on Qtask〉 ≡
browse http://www.qtask.com/help.cgi?qwikititle=Help%20-%2010%20-%20Qwiki&qWikiRef=header-12
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〉 ≡
〈Utility functions〉
〈Load and save functions〉
〈Edit functions〉
The quit? function checks if the current document has been modified (see 〈Utility functions〉), and quits the program.
〈Load and save 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.
〈Load and save 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.
〈Load and save 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.
〈Load and save 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.
〈Load and save 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.
〈Load and save functions〉 +≡
save-qml: has [file err] [
if 〈the user gives a 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).
〈Load and save 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 〈the user gives a file name〉 [
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.
〈Load and save 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 〈the user gives a file name〉 [
if error? err: try [write file gen-pdfdoc none] [
print form-error/all disarm err
alert join "Error saving file: " form-error disarm err
]
]
]
Request a file name to save the QML text:
〈the user gives a file name〉 ≡
file: req-save "Save QML file" any [current-file-name %New%20QML%20document] %.qml
Request a file name to save the HTML output:
〈the user gives a file name〉 ≡
file: req-save "Save HTML file" any [file %New%20HTML%20document] %.html
Request a file name to save the PDF output:
〈the user gives a file name〉 ≡
file: req-save "Save PDF file" any [file %New%20PDF%20document] %.pdf
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 "] "]
]
]
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]
]
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 the default event function to avoid unwanted unfocusing〉 ≡
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
]