Skip to content

GitLab

Commit 2bd77cbd authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 994679bd
Hide whitespace changes
Inline Side-by-side
libraries/iData/PrintUtil.dcl
View file @ 2bd77cbd
......@@ -15,7 +15,7 @@ import DataFile
:: *NWorld // io states...
= { worldC :: !*World // world for any io
, inout :: !*HtmlStream // to read from stdin and write to stdout
, gerda :: !*Gerda // to read and write to a relational database
, gerda :: *Gerda // to read and write to a relational database
, datafile :: !*DataFile // to read and write to a Clean database in a file
}
instance FileSystem NWorld
......@@ -35,7 +35,7 @@ derive gHpr Int, Real, Bool, String, Char, []
// the main print routine
print_to_stdout :: !a !*NWorld -> *NWorld | gHpr{|*|} a
print_to_stdout :: !a !*HtmlStream -> *HtmlStream | gHpr{|*|} a
// handy utility print routines
......
libraries/iData/PrintUtil.icl
View file @ 2bd77cbd
......@@ -3,10 +3,7 @@ implementation module PrintUtil
import StdArray, StdFile, StdList, StdString, ArgEnv
import StdGeneric
import StdStrictLists
import Gerda
import DataFile
:: Url :== String
import iDataSettings
generic gHpr a :: !*HtmlStream !a -> *HtmlStream
......@@ -58,10 +55,8 @@ print a = \f -> [|a:f]
(<+>) infixl :: !*HtmlStream !FoF -> *HtmlStream
(<+>) file new = new file
print_to_stdout :: !a !*NWorld -> *NWorld | gHpr{|*|} a
print_to_stdout value nw=:{inout}
# inout = inout <+ value
= {nw & inout = inout}
print_to_stdout :: !a !*HtmlStream -> *HtmlStream | gHpr{|*|} a
print_to_stdout value inout = inout <+ value
htmlCmnd :: !a !b -> FoF | gHpr{|*|} a & gHpr{|*|} b
htmlCmnd hdr txt = \file -> closeCmnd hdr (openCmnd hdr "" file <+ txt)
......
libraries/iData/iDataHandler.dcl
View file @ 2bd77cbd
......@@ -39,6 +39,7 @@ doHtmlServer :: !(*HSt -> (Html,!*HSt)) !*World -> *World
// don't use the following experimental functions
doHtmlClient :: !(*HSt -> (Html,!*HSt)) !*World -> *World
doHtmlServer2 :: ![(String,*HSt -> (Html,!*HSt))] !*World -> *World
doMyHtmlServerAjax :: !(*HSt -> (Html,!*HSt)) !*World -> *World
// mkViewForm is the *swiss army knife* function creating stateful interactive forms with a view v of data d.
// Make sure that all editors have a unique identifier!
......
libraries/iData/iDataHandler.icl
View file @ 2bd77cbd
......@@ -62,6 +62,38 @@ callSapl f world
= abort allhtmlcode
//= world
// doMyHtmlServerAjax has an extra function in the list for the default case
// the other one generates the inner html
doMyHtmlServerAjax :: !(*HSt -> (Html,!*HSt)) !*World -> *World
doMyHtmlServerAjax userpage world
= StartServer SocketNr [(ThisExe, \_ _ args -> defaultpage args), // empty page with script and div
(ThisExe +++ "_ajax", \_ _ args -> doHtmlPageAndPrint args userpage)] world
defaultpage _ world = ([], page,world)
where page = "<html>" +++
"<head>" +++
"<link type=\"text/css\" rel=\"stylesheet\" href=\"" +++ ThisExe +++ "/clean.css\" />" +++ // clean styles now code in sepparate style sheet
"<script language=\"JavaScript\" src=\"" +++ ThisExe +++ "/ajaxscript.js\"></script>" +++ // script for handling ajax code
// "<script language=\"JavaScript\" src=\"" +++ ThisExe +++ "/jsxml/rexml.js\"></script>" +++ // script to turn the response text into dom document format
"</head>" +++
"<body background = " +++ ThisExe +++ "/back35.jpg class = CleanStyle>" +++
"<div id=\"thePage\" class=\"thread\">" +++ ThisExe +++ "</div>" +++
"</body>" +++
"</html>"
/*
defaultpage2 args world
# inout = print_to_stdout // Print out all html code
(Html (Head [] [extra_style])
(Body extra_body_attr [[debugInput]]))
[|]
= ([],inout,world)
where
extra_body_attr = [Batt_background (ThisExe +++ "/back35.jpg"),`Batt_Std [CleanStyle]]
extra_style = Hd_Style [] CleanStyles
debugInput = if TraceInput (traceHtmlInput args) EmptyBody
*/
/////////////////////////////////
......@@ -95,15 +127,23 @@ where
# (Html (Head headattr headtags) (Body attr bodytags),{states,world})
= userpage (mkHSt initforms nworld) // Call the user application
# (debugOutput,states) = if TraceOutput (traceStates states) (EmptyBody,states) // Optional show debug information
# (allformbodies,nworld) = storeFormStates states world // Store all state information
# {worldC,gerda,inout,datafile}
= print_to_stdout // Print out all html code
(Html (Head headattr [extra_style:headtags])
(Body (extra_body_attr ++ attr) [allformbodies:bodytags++[debugInput,debugOutput]]))
nworld
# world = closeDatabase gerda worldC // close the relational database if option chosen
# world = closemDataFile datafile world // close the datafile if option chosen
= (inout,world)
# (allformbodies,world=:{worldC,gerda,inout,datafile})
= storeFormStates states world // Store all state information
# worldC = closeDatabase gerda worldC // close the relational database if option chosen
# worldC = closemDataFile datafile worldC // close the datafile if option chosen
# inout = //IF_Ajax
//(print_to_stdout
// ("<div id=\"theNewPage\" class=\"thread\">" +++ "Zal dit werken" +++ "</div>")
// ("<div id=\"theNewPage\" class=\"thread\">" +++ "Zal dit werken" +++ "</div>")
// ([allformbodies:bodytags])
// (Body attr [allformbodies:bodytags++[debugInput,debugOutput]])
// inout)
(print_to_stdout // Print out all html code
(Html (Head headattr [extra_style:headtags])
(Body (extra_body_attr ++ attr) [allformbodies:bodytags++[debugInput,debugOutput]]))
inout)
= (inout,worldC)
where
extra_body_attr = [Batt_background (ThisExe +++ "/back35.jpg"),`Batt_Std [CleanStyle]]
extra_style = Hd_Style [] CleanStyles
......
libraries/iData/iDataHtmlDef.dcl
View file @ 2bd77cbd
......@@ -691,4 +691,4 @@ None :== [NoAttr]
import PrintUtil
derive gHpr Html, BodyTag, ColorOption, TxtDir
derive gHpr Html, BodyTag, ColorOption, TxtDir, Rest
libraries/iData/iDataSettings.dcl
View file @ 2bd77cbd
......@@ -70,8 +70,8 @@ IF_Database db no_db :== db // If Database option is used
IF_DataFile df no_df :== df // If DataFile option is used
//IF_DataFile df no_df :== no_df // otherwise, BUT also manually flag of ", read {|*|}, write {|*|}" in the iSpecialStore class definition above
//IF_Ajax th no_th :== th // If you want to create sub-pages, threads and "Ajax" technologie
IF_Ajax th no_th :== no_th // Otherwise
IF_Ajax th no_th :== th // If you want to create sub-pages, threads and "Ajax" technologie
//IF_Ajax th no_th :== no_th // Otherwise
// Global Settings determining where files are stored
......
libraries/iTasks/iTasks.icl
View file @ 2bd77cbd
......@@ -224,23 +224,24 @@ startTstTask thisUser multiuser chooseoption traceOn versionsOn taska tst=:{hst,
= IF_Ajax (if TraceThreads showThreadTable (\tst -> ([],tst)) {tst & hst = hst}) ([],{tst & hst = hst})
# threadsText = foldl (+++) "" [showTaskNr tasknrs +++ " + " \\ tasknrs <- threads]
# (selbuts,selname,seltask,hst) = Filter thisUser defaultUser ((defaultUser,"Main") @@: html) hst
= ( a,
[Table [Tbl_Width (Percent 100)] [Tr []
[ Td [] [BCTxt Aqua "i-Task", CTxt Yellow " - Multi-User Workflow System "]
, Td [Td_Align Aln_Right] (chooseoption ++ refresh.form ++ ifTraceOn traceAsked.form)] ]]++
[Hr []] ++
if multiuser
[Txt "User nr: " , CTxt Silver thisUser, Txt " - Querie nr: ", CTxt Silver appversion.value]
[Txt "Querie nr: ", CTxt Silver appversion.value] ++
IF_Ajax
[Txt " - Event nr: ", CTxt Silver (showTaskNr event),Txt " - Thread nr(s): ", CTxt Silver threadsText,Br,Hr []]
[Hr []]
++
if (doTrace && traceOn)
(showOptions ++ threadtrace ++ [printTrace2 trace ])
[ STable [] [ [BodyTag selbuts, selname <||> seltask ]
]
]
= ( a, //mkDiv "thePage"
( [Table [Tbl_Width (Percent 100)] [Tr []
[ Td [] [BCTxt Aqua "i-Task", CTxt Yellow " - Multi-User Workflow System "]
, Td [Td_Align Aln_Right] (chooseoption ++ refresh.form ++ ifTraceOn traceAsked.form)] ]]++
[Hr []] ++
if multiuser
[Txt "User nr: " , CTxt Silver thisUser, Txt " - Querie nr: ", CTxt Silver appversion.value]
[Txt "Querie nr: ", CTxt Silver appversion.value] ++
IF_Ajax
[Txt " - Event nr: ", CTxt Silver (showTaskNr event),Txt " - Thread nr(s): ", CTxt Silver threadsText,Br,Hr []]
[Hr []]
++
if (doTrace && traceOn)
(showOptions ++ threadtrace ++ [printTrace2 trace ])
[ STable [] [ [BodyTag selbuts, selname <||> seltask ]
]
]
)
,{tst & hst = hst})
where
startMainTask :: !(Task a) !*TSt -> ((Maybe a,TaskNr,[TaskNr]),*TSt) // No threads, always start from scratch
......@@ -993,7 +994,7 @@ BCTxt color message
mkDiv :: String [BodyTag] -> [BodyTag]
mkDiv id bodytag = [normaldiv]
where
normaldiv = Div [`Div_Std [Std_Id id]] bodytag
normaldiv = Div [`Div_Std [Std_Id id, Std_Class "thread"]] bodytag
// Printing and tracing stuf...
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment