Commit d120bc74 authored by Diederik van Arkel's avatar Diederik van Arkel

Commit windows mods

parent c85ad9d9
......@@ -4,6 +4,7 @@ definition module EdLineText
from StrictList import :: StrictList
from EdPosition import :: LineNr
from syncol import :: Info
:: Text
:: TextFragment
......@@ -25,7 +26,7 @@ lastLineNr :: !Text -> LineNr
validateLineNr :: !LineNr Text -> LineNr
getLine :: !LineNr !u:Text -> (!String, !u:Text)
getLineC :: !LineNr !u:Text -> ((!Int,!String), !u:Text)
getLineC :: !LineNr !u:Text -> ((!Info,!String), !u:Text)
getLines :: LineNr LineNr Text -> (StrictList String, Text)
//getLinesC :: LineNr LineNr Text -> (StrictList (Int,String), Text)
......
......@@ -21,8 +21,8 @@ where
export TextAnnot Void, SyncInf, ConsInf
*/
:: LineAnnot :== Int
dummyLineAnnot :== 0
:: LineAnnot :== Info
dummyLineAnnot :== (0,False)
annotLine :== slMap (\s->(dummyLineAnnot,s))
annotWhole :== firstParse
annotPart :== quickParse
......@@ -64,7 +64,7 @@ textToStrings :: !Text -> StrictList String
textToStrings { blocks }
= blocksToStrings blocks
textToStringsC :: !Text -> StrictList (Int,String)
textToStringsC :: !Text -> StrictList (Info,String)
textToStringsC { blocks }
= blocksToStringsC blocks
......@@ -133,15 +133,15 @@ where
StringToText s
:== stringsToText (stringToStrings s)
blockToStrings :: !(StrictList (Int,String)) -> StrictList String
blockToStrings :: !(StrictList (Info,String)) -> StrictList String
blockToStrings block = slMap snd block
blocksToStrings :: ![StrictList (Int,String)] -> StrictList String
blocksToStrings :: ![StrictList (Info,String)] -> StrictList String
blocksToStrings [] = SNil
blocksToStrings [block:blocks]
= slAppend (blockToStrings block) (blocksToStrings blocks)
blocksToStringsC :: ![StrictList (Int,String)] -> StrictList (Int,String)
blocksToStringsC :: ![StrictList (Info,String)] -> StrictList (Info,String)
blocksToStringsC [] = SNil
blocksToStringsC [block:blocks]
= slAppend block (blocksToStringsC blocks)
......@@ -181,7 +181,7 @@ where
nrSkip = lineNr / BlockSize
theBlock = blocks!!nrSkip
getLineC :: !LineNr !u:Text -> ((!Int,!String), !u:Text)
getLineC :: !LineNr !u:Text -> ((!Info,!String), !u:Text)
getLineC linenr text=:{nrLines, blocks}
# line = slIndex lineNr` theBlock
= ( line, text)
......@@ -197,7 +197,7 @@ where
// denotes by the line numbers. It also returns the number of
// the first block
getBlocks :: LineNr LineNr Text -> (Int, [StrictList (Int,String)])
getBlocks :: LineNr LineNr Text -> (Int, [StrictList (Info,String)])
getBlocks first last { blocks }
= ( nrSkip
, blocks%(nrSkip,nrTake)
......@@ -216,7 +216,7 @@ where
(firstBlockNr, blocks) = getBlocks first last text
first` = first - firstBlockNr * BlockSize
getLinesC :: LineNr LineNr Text -> (StrictList (Int,String), Text)
getLinesC :: LineNr LineNr Text -> (StrictList (Info,String), Text)
getLinesC first last text
# lines = textToStringsC text
# lines = slTake (last - first + 1) (slDrop first lines)
......
......@@ -53,6 +53,7 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
, stringColour :: !Colour
, charColour :: !Colour
, keywordColour :: !Colour
, typedefColour :: !Colour
}
DefaultSyntaxColours :: SyntaxColours
......
......@@ -87,6 +87,7 @@ import EdAction
, stringColour :: !Colour
, charColour :: !Colour
, keywordColour :: !Colour
, typedefColour :: !Colour
}
instance toString ActionInfo
......@@ -410,6 +411,7 @@ DefaultSyntaxColours =
, stringColour = Green
, charColour = Magenta
, keywordColour = Grey
, typedefColour = Black
}
//--
......
......@@ -91,7 +91,7 @@ mouse (MouseDrag point modifiers) // mouse drag
getText >>>= \text ->
vChangeSelectionTo (selectLines firstLine newPosition.row text)
) >>>
vScrollToCursor
vDragCursor point
mouse (MouseUp point modifiers) // mouse up handling
= getSelection >>>= \selection ->
......
definition module EdPosition
from StdClass import class <, class ==
from StdClass import class <, class ==, class toString
:: Position
= { col :: ColumnNr
......@@ -12,3 +12,4 @@ from StdClass import class <, class ==
instance < Position
instance == Position
instance toString Position
implementation module EdPosition
import StdClass, StdBool, StdInt
import StdClass, StdBool, StdInt, StdString
:: Position
= { col :: ColumnNr
......@@ -20,3 +20,5 @@ instance < Position where
(<) { col=col1, row=row1 } { col=col2, row=row2 }
= row1 < row2 || (row1 == row2 && col1 < col2)
instance toString Position where
toString {col,row} = "(" +++ toString row +++ "," +++ toString col +++ ")"
......@@ -2,9 +2,10 @@ definition module EdTab
// functions that deal with those annoying tab characters
from StdIOCommon import :: Point2
from StdPicture import :: Picture
from EdMonad import :: FontInfo
from StdIOCommon import :: Point2
from StdPicture import :: Picture
from EdMonad import :: FontInfo
from syncol import :: Info
splitAtTabs :: !String -> .[String]
// splitAtTabs: splits a string into several strings that were
......@@ -17,7 +18,6 @@ tabTake :: !Int [String] -> [String]
// ["abc",""]
tabDrawString :: !Point2 !String !FontInfo !*Picture -> *Picture
tabDrawStringC :: !Point2 !(!Int,!String) !FontInfo !*Picture -> *Picture
tabDrawStringC :: !Point2 !(!Info,!String) !FontInfo !*Picture -> *Picture
// tabDrawString: draws a string containing tabs properly.
// tabDrawStringC: draws a string containing tabs properly with syntax colours.
This diff is collapsed.
......@@ -23,6 +23,10 @@ vScrollToCursor :: EditMonad (PSt .l) nothing
// vScrollToCursor: scrolls the view frame up to the point that the cursor
// becomes visible.
vDragCursor :: !Point2 -> EditMonad (PSt .l) nothing
// vDragToCursor: scrolls the view frame up to the point that the cursor
// becomes visible with space to spare.
vMoveCursor :: !Movement -> EditMonad (PSt .l) nothing
vDoCursorSafe :: (EditMonad (PSt .l) a) -> EditMonad (PSt .l) a
......
......@@ -10,18 +10,22 @@ import ioutil, StrictList
//--
vCenterCursor :: EditMonad (PSt .l) nothing
vCenterCursor = vMakeCursorVisible True
vCenterCursor = vMakeCursorVisible True Nothing
vScrollToCursor :: EditMonad (PSt .l) nothing
vScrollToCursor = vMakeCursorVisible False
vScrollToCursor = vMakeCursorVisible False Nothing
vMakeCursorVisible :: !Bool -> EditMonad (PSt .l) nothing
vMakeCursorVisible center =
vDragCursor :: !Point2 -> EditMonad (PSt .l) nothing
vDragCursor point = vMakeCursorVisible False (Just point)
vMakeCursorVisible :: !Bool !(Maybe Point2) -> EditMonad (PSt .l) nothing
vMakeCursorVisible center drag =
getWindowId >>>= \windowId ->
accEnv (accPIO (getWindowViewFrame windowId)) >>>= \viewFrame ->
getSelection >>>= \{end} ->
// accEnv (accPIO (getWindowViewDomain windowId)) >>>= \viewDomain ->
getSelection >>>= \{start,end} ->
getText >>>= \text ->
getFontInfo >>>= \fontInfo=:{FontInfo | lineHeight} ->
getFontInfo >>>= \fontInfo=:{FontInfo | lineHeight,charWidth} ->
let // give names to the components of the view frame
cursorPoint = positionToPoint end text fontInfo
left = viewFrame.corner1.x
......@@ -31,14 +35,80 @@ vMakeCursorVisible center =
// determine whether the cursor is on the
// correct (visible) side of the borders
leftOk = cursorPoint.x >= left
rightOk = cursorPoint.x <= right
leftOk = cursorPoint.x - charWidth >= left
// leftOk = case end.col of
// 0 -> (fromJust viewDomain).corner1.x = left
// _ -> cursorPoint.x - charWidth >= left
rightOk = cursorPoint.x + charWidth <= right
topOk = cursorPoint.y >= top
bottomOk = cursorPoint.y + lineHeight <= bottom
cursorOk = leftOk && rightOk && topOk && bottomOk
singleline= end.row - start.row == 0
(dontMove,nrHPixels)
= case drag of
Just point #
hslop` = charWidth
vslop` = lineHeight
// leftOk` = point.x - hslop` >= left
// rightOk` = point.x + hslop` <= right
leftOk` = point.x >= left
rightOk` = point.x <= right
topOk` = point.y >= top
bottomOk` = point.y <= bottom
mouseOk = leftOk` && rightOk` && topOk` && bottomOk`
hslop`` = charWidth * 8
vslop`` = lineHeight
leftOk`` = cursorPoint.x - hslop`` >= left
rightOk`` = cursorPoint.x + hslop`` <= right
topOk`` = cursorPoint.y >= top
bottomOk`` = cursorPoint.y + vslop`` <= bottom
cursorOk`` = leftOk`` && rightOk`` && topOk`` && bottomOk``
/*
nrHPixels = if (leftOk`` && rightOk``)
0
(if rightOk``
( point.x - hslop` - left )
( point.x + hslop` - right )
)
*/
nrHPixels`` = if (leftOk`` && rightOk``)
0
(if rightOk``
(~charWidth)//( point.x - hslop` - left )
charWidth//( point.x + hslop` - right )
)
nrHPixels = if (leftOk && rightOk)
0
(if rightOk
( cursorPoint.x - charWidth - left )
( cursorPoint.x + charWidth - right )
)
/* nrHPixels = if (leftOk`` && rightOk``)
0
(if rightOk``
( cursorPoint.x - hslop`` - left )
( cursorPoint.x + hslop`` - right )
)
*/
// -> (if singleline (mouseOk || cursorOk``) (cursorOk``), nrHPixels)
-> if singleline
(mouseOk || cursorOk``,nrHPixels``)
(cursorOk``,nrHPixels)
Nothing #
nrHPixels = if (leftOk && rightOk)
0
(if rightOk
( cursorPoint.x - charWidth - left )
( cursorPoint.x + charWidth - right )
)
-> (cursorOk, nrHPixels)
in
// if cursor is visible, nothing has to be done
IF (leftOk && rightOk && topOk && bottomOk)
IF (dontMove)
THEN
( skip )
ELSE
......@@ -47,7 +117,7 @@ vMakeCursorVisible center =
halfWidth = ( right - left ) / 2
newTop = if (topOk && bottomOk) top (cursorPoint.y - halfHeight)
newLeft = if (leftOk && rightOk) left (cursorPoint.x - halfWidth)
nrPixels = if (topOk && bottomOk)
nrVPixels = if (topOk && bottomOk)
0 // if visible do nothing
(if bottomOk
( cursorPoint.y - top ) // if move up move to top...
......@@ -55,7 +125,7 @@ vMakeCursorVisible center =
)
vector = if center
{ vx = newLeft - left, vy = newTop - top }
{ vx = newLeft - left, vy = nrPixels }
{ vx = nrHPixels, vy = nrVPixels }
in
appEnv (appPIO (moveWindowViewFrame windowId vector))
)
......@@ -146,11 +216,13 @@ vUpdateCursor visible end height fontInfo text viewFrame rectangles =
{x,y} = point
in
IF (any (isCursorInRectangle point height) rectangles)
THEN (seq
// THEN (seq
THEN (appXorPicture (seq
[ setPenColour Black
, drawLine { x=x, y=y }
{ x=x, y=y+height - 1 }
])
// ])
]))
ELSE
id
)
......@@ -165,13 +237,26 @@ vDrawCursor show end cursorHeight text fontInfo =
in
// ( appXorPicture (seq
// [ setPenColour Black
/*
( (seq
[ setPenColour (if show Black fontInfo.syntaxColours.backgroundColour)
, drawLine { x=x, y=y }
{ x=x, y=y+cursorHeight - 1 }
])
)
*/
( if show
(appXorPicture (seq
[ setPenColour Black
, drawLine { x=x, y=y }
{ x=x, y=y+cursorHeight - 1 }
]))
(seq
[ setPenColour (fontInfo.syntaxColours.backgroundColour)
, drawLine { x=x, y=y }
{ x=x, y=y+cursorHeight - 1 }
])
)
//--- Visual Selection Stuff
vUpdateSelection :: !Selection FontInfo Text ViewFrame [Rectangle] -> (*Picture -> *Picture)
......
......@@ -5,5 +5,7 @@ definition module syncol
import StdString
import StrictList
firstParse :: !(StrictList String) -> StrictList (Int,String)
quickParse :: !Int !Int !(StrictList (Int,String)) -> (Int,StrictList (Int,String))
:: Info :== (!Int,!Bool)
firstParse :: !(StrictList String) -> StrictList (Info,String)
quickParse :: !Int !Int !(StrictList (Info,String)) -> (Int,StrictList (Info,String))
......@@ -9,13 +9,12 @@ import StrictList
parseLine: initial comment nesting level & textline -> new comment nesting level
*/
parseLine :: !.Int !.String -> Int
parseLine :: !.Info !.String -> Info
parseLine comment_level line
= pL comment_level 0
where
funnyChar c = isStringMember c (dec funnySize) funnyChars
//isStringMember:: a !.[a] -> .Bool | Eq a
isStringMember :: !Char !Int !String -> Bool
isStringMember x i s
| i < 0 = False
......@@ -28,64 +27,89 @@ where
line_size = size line
pL :: !Int !Int -> Int
pL l i // parse normal text
| i >= line_size = l
pL :: !Info !Int -> Info
pL (level,typedef) i // parse normal text
| i >= line_size = (level,typedef)
#! char = line.[i]
| char == '*'
# i = inc i
| i >= line_size = l
| i >= line_size = (level,typedef)
| line.[i] == '/'
#! i = inc i
| l <> 0 = pL (dec l) i // try to fix problem below
| level <> 0 = pL (dec level,typedef) i // try to fix problem below
| i < line_size && funnyChar line.[i]
= scanFunny l i // hmmm excludes */*/ and *//*...*/
= pL (dec l) i
= pL l i
= scanFunny (level,typedef) i // hmmm excludes */*/ and *//*...*/
= pL (dec level,typedef) i
= pL (level,typedef) i
| char == '/'
#! i = inc i
| i >= line_size = l
| i >= line_size = (level,typedef)
#! char = line.[i]
| char == '/' = l // shouldn't we exclude funnyId's ??
| char == '*' = pL (inc l) (inc i)
= pL l i
| (char == '"') && (l == 0)
= pS (inc i)
| (char == '\'') && (l == 0)
= pC (inc i)
| (l == 0) && (funnyChar char)
= scanFunny l i
= pL l (inc i)
| char == '/' = (level,typedef) // shouldn't we exclude funnyId's ??
| char == '*' = pL (inc level,typedef) (inc i)
= pL (level,typedef) i
| (char == '"') && (level == 0)
= pS (level,typedef) (inc i)
| (char == '\'') && (level == 0)
= pC (level,typedef) (inc i)
| (level == 0) && (funnyChar char)
= scanFunny (level,typedef) i
| i == 0 && not (WhiteSpace char)
= pL (level,False) (inc i)
= pL (level,typedef) (inc i)
scanFunny l i
| i >= line_size = pL l line_size
scanFunny (level=:0,typedef) 0
| (line_size == 2 && line == "::")
|| (line_size >= 3 && line%(0,1) == "::" && not (funnyChar line.[2]))
= pL (level,True) 2
# c = line.[0]
| typedef
| (line_size == 1 && (line == "|" || line == "="))
|| (line_size >= 2 && (line%(0,0) == "|" || line%(0,0) == "=") && not (funnyChar line.[1]))
|| (line_size == 3 && line == ":==")
|| (line_size >= 4 && line%(0,2) == ":==" && not (funnyChar line.[3]))
= pL (level,typedef) 1
| funnyChar c
= scanFunny (level,False) 1
= pL (level,False) 0
| funnyChar c
= scanFunny (level,typedef) 1
= pL (level,typedef) 0
where
no_c` = line_size < 2
c` = line.[1]
scanFunny (level,typedef) i
| i >= line_size = pL (level,typedef) line_size
#! c = line.[i]
| funnyChar c = scanFunny l (inc i)
= pL l i
| funnyChar c = scanFunny (level,typedef) (inc i)
= pL (level,typedef) i
pS i // parse string constant
| i >= line_size = 0 // unterminated string constant...
pS cl i // parse string constant
| i >= line_size = cl // unterminated string constant...
# char = line.[i]
| char == '"' = pL 0 (inc i)
| char == '"' = pL cl (inc i)
| char == '\\'
= pS (i + 2)
= pS (inc i)
= pS cl (i + 2)
= pS cl (inc i)
pC i // parse character constant
| i >= line_size = 0 // unterminated char constant...
pC cl i // parse character constant
| i >= line_size = cl // unterminated char constant...
# char = line.[i]
| char == '\'' = pL 0 (inc i)
| char == '\\' = pC (i + 2)
= pC (inc i)
| char == '\'' = pL cl (inc i)
| char == '\\' = pC cl (i + 2)
= pC cl (inc i)
// pT i // parse type
WhiteSpace c
:== c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f';
/*
firstParse: textlines -> zip initial comment nesting level & textlines
*/
firstParse :: !(StrictList String) -> StrictList (Int,String)
firstParse :: !(StrictList String) -> StrictList (Info,String)
firstParse lines
= slFromList (fP 0 lines)
= slFromList (fP (0,False) lines)
where
fP i SNil
= []
......@@ -93,31 +117,19 @@ where
#! j = parseLine i h
= [ (i,h) : (fP j t) ]
/*
firstParse lines
= fP 0 lines
where
fP i SNil
= (i,SNil)
fP i (SCons h t)
#! j = parseLine i h
# (k,r) = fP j t
= (k,SCons (i,h) r)
*/
/*
quickParse: (first modified line) (last modified line) textlines
-> last changed line with different comment nesting & textlines
*/
quickParse :: !Int !Int !(StrictList (Int,String)) -> (Int,StrictList (Int,String))
quickParse :: !Int !Int !(StrictList (Info,String)) -> (Int,StrictList (Info,String))
quickParse fln lln text = qP 0 text id
where
// parse before modified
qP :: !Int !.(StrictList (Int,String)) ((StrictList (Int,String)) -> (StrictList (Int,String))) -> (Int, (StrictList (Int,String)))
qP :: !Int !.(StrictList (Info,String)) ((StrictList (Info,String)) -> (StrictList (Info,String))) -> (Int, (StrictList (Info,String)))
qP cln SNil c = (cln,c SNil)
qP cln (SCons h=:(i,l) t) c
| cln < fln = qP (inc cln) t (SC c h)
| cln > lln = qR 0 cln (SCons h t) c
| cln > lln = qR (0,False) cln (SCons h t) c
#! k = parseLine i l
| cln < lln
= qS k (inc cln) t (SC c h)
......@@ -132,20 +144,11 @@ where
= qR k (inc cln) t (SC c (i,l))
// parse after modified
qR k cln SNil c = (cln, c SNil)
qR k cln r=:(SCons (i,l) t) c
| k == i = (dec cln,c r)
# d = k - i
= (cln+slLength t,c (slMap (\(i,l) -> (i+d,l)) r))
qR _ cln SNil c = (cln, c SNil)
qR (level,typedef) cln r=:(SCons ((level`,typedef`),l) t) c
| level == level` && typedef == typedef`
= (dec cln,c r)
# k = parseLine (level,typedef) l
= qR k (inc cln) t (SC c ((level,typedef),l))
SC c h = \t -> c (SCons h t)
//--
/*
Extension to datatype definitions simple...
Need to replace Int by alg datatype
int now indicates comment nesting level...
need to differentiate is/isn't dtd
Normal Int | DTD Int
then check in column 0 if it says '::'...
*/
......@@ -264,4 +264,4 @@ where
content_size fm {node_size_list}
# lh = fontLineHeight fm
= lh * (1+length node_size_list) + fm.fLeading// omdat we altijd totaal laten zien...
\ No newline at end of file
......@@ -36,7 +36,15 @@ import StdSystem
trace_n _ f :== f
//--
import Directory
ensureDirectory pd_string env
# ((ok,path),env) = pd_StringToPath pd_string env
| not ok
= (ok,env)
# (err_code, env) = createDirectory path env
= (err_code==NoDirError || err_code==AlreadyExists, env)
//import dodebug
Start :: !*World -> *World
Start world
# (stup,world) = accFiles GetFullApplicationPath world
......@@ -44,16 +52,27 @@ Start world
(mEdUndoId,world) = openId world
(mMdEdOptId,world) = openId world
// check for PrefsDir existence here...
// check for EnvsDir existence here...
// check for TooltempDir existence here...
# (ok,world) = ensureDirectory PrefsDir world
| not ok
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
# (ok,world) = ensureDirectory EnvsDir world
| not ok
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
# (ok,world) = ensureDirectory TempDir world
| not ok
= abort ("Missing directory for preferences:\n" +++ PrefsDir +++ "\nUnable to create it.\n")
# prefspath = MakeFullPathname PrefsDir PrefsFileName
#! (prefs,world) = openPrefs prefspath world
# envspath = MakeFullPathname EnvsDir EnvsFileName
#! (iniTargets,world)
= openEnvironments stup envspath world
#! (iniTargets,world) = openEnvironments stup envspath world
// # envspath = EnvsDir
// # (iniTargets,world) = getEnvironments stup envspath world
// # world = trace_n` ("entries",listToString entries) world
// #! (iniTargets,world)
// = openEnvironments stup envspath world
# (ffind,world) = initFindBoxInfo prefs world
# (iniTwi,world) = iniTypeWinInfo mEditId mEdUndoId ([]) prefs.typ_prefs world
......@@ -94,6 +113,7 @@ Start world
world
# patt = [ ProcessClose (Quit prefspath)
, ProcessOpenFiles openfiles
// , ProcessActivate (trace_n` "ACTIVATE!")
// , ProcessClipboardChanged clip_changed
: toolbar
] ++ PlatformProcessAttributes
......@@ -297,8 +317,8 @@ fileMenu prefspath {mn_clo,mn_sva,mn_sav,mn_rev,mn_oth,mn_prt,mn_prs,mn_odm,mn_o
[ MenuFunction (noLS ed_print_all)
]
:+: MenuSeparator []
:+: FileHistMenu "Recent Files" 12 mFileId fhRecId mFhMenId (StrictListToList prefs.file_hist) (\s->ed_open_cont s (\_ _ -> id))
:+: FileHistMenu "Recent Projects" 12 mFileId phRecId mPhMenId (StrictListToList prefs.proj_hist) pmopen
:+: FileHistMenu "Recent Files" 12 mFileId fhRecId mFhMenId (StrictListToList prefs.file_hist) fhopen
:+: FileHistMenu "Recent Projects" 12 mFileId phRecId mPhMenId (StrictListToList prefs.proj_hist) phopen
:+: MenuSeparator []
:+: MenuItem "&Quit"
[ MenuShortKey 'Q'
......@@ -317,9 +337,16 @@ where
= (ls,ps)
# ps = pm_new ps
= (ls,ps)
pmopen pathName ps
# (ok,ps) = pm_switch pathName ps
= ps
fhopen pathName ps
= ed_open_cont pathName cont ps
where
cont _ _ ps
# (_,ps) = syncSend2 fhRecId pathName ps
= ps
phopen pathName ps
= pm_open_path pathName ps
// # (ok,ps) = pm_switch pathName ps
// = ps
searchMenu altgr_workaround mSearchId {srchIds,findIds,gotoIds,nextIds}
= Menu "&Search"
......@@ -409,6 +436,9 @@ projectMenu
, MenuId (projIds!!12)
, MenuSelectState Unable
]
:+: MenuItem "Project Defaults..."
[ MenuFunction (noLS projectDefaults)
]
:+: MenuSeparator []
:+: MenuItem "Show &Heap Profile"
[ MenuFunction (noLS shoheapfun)
......@@ -425,10 +455,10 @@ projectMenu
, MenuId (projIds!!8)
, MenuSelectState Unable
]
:+: MenuItem "Theorem Prover Module"
[ MenuSelectState Unable
, MenuId (projIds!!9)
]
// :+: MenuItem "Theorem Prover Module"
// [ MenuSelectState Unable
// , MenuId (projIds!!9)
// ]
:+: MenuSeparator []
:+: ProjListMenu mProjectId mPrListId mPrRecId
)
......@@ -466,6 +496,9 @@ moduleMenu {md_cmp,md_chk,md_gen,md_cst,md_est} =
, MenuSelectState Unable
, MenuShortKey 'J' // 'Fix' ctrl-J -> newline bug.
]
:+: MenuItem "Module Defaults..."
[ MenuFunction (noLS pm_coprefs)
]
/*
:+: MenuItem "Editor Settings..."
[ MenuShortKey 'J'
......@@ -479,14 +512,7 @@ moduleMenu {md_cmp,md_chk,md_gen,md_cst,md_est} =
optionsMenu mOptionsId
= Menu "&Defaults"
( MenuItem "Module Defaults..."
[ MenuFunction (noLS pm_coprefs)
]
:+: MenuItem "Project Defaults..."
[ MenuFunction (noLS projectDefaults)
]
:+: MenuSeparator []
:+: SubMenu "Window Settings"
( SubMenu "Window Settings"
( MenuItem "Editor Colours..."
[ MenuFunction (noLS editColours)
]
......@@ -549,7 +575,7 @@ ed_open {shiftDown} ps
Quit :: !String !(PSt *General) -> (PSt *General)
Quit prefspath ps
= ed_ask_save_all True cont ps
= ed_ask_save_all True False cont ps
where
cont ps
// save project
......@@ -655,7 +681,7 @@ ide_close ps
= ps
ide_close_all pstate
= ed_ask_save_all True id pstate
= ed_ask_save_all True True id pstate
ide_save mods ps
| mods.altDown || mods.optionDown
......@@ -906,7 +932,7 @@ where
= ps
//--
import StdClipboard
ed_Undo ps
# (_,ps) = sendToActiveWindow msgUndo ps
= mb_update_undoinfo ps
......@@ -915,16 +941,27 @@ ed_Paste ps
# (_,ps) = sendToActiveWindow msgPaste ps
= mb_update_undoinfo ps
ed_Copy pstate
# (res,pstate) = sendToActiveWindow msgCopy pstate
ed_Copy ps
# (res,ps) = sendToActiveWindow msgCopy ps
| isNothing res
# (win,pstate) = accPIO (getActiveWindow) pstate
# (isErrWin,ps) = ew_is_active ps
| isErrWin
# (errinf,ps) = getErrInfo ps
# lbId = errinf.infoId
# ((ok,sel),ps) = getFilteredListBoxSelection lbId ps
| not ok = ps
# sel = map fst sel
# string = foldr (\l r->l+++"\n"+++r) "" sel
# newclip = [toClipboard string]
# ps = setClipboard newclip ps
= ps
# (win,ps) = accPIO (getActiveWindow) ps
| isNothing win
= pstate
= ps
# win = fromJust win
# (_,pstate) = maybe_type_win_message win msgCopy pstate
= mb_update_undoinfo pstate
= mb_update_undoinfo pstate
# (_,ps) = maybe_type_win_message win msgCopy ps
= mb_update_undoinfo ps
= mb_update_undoinfo ps
ed_Cut pstate
# (res,pstate) = sendToActiveWindow msgCut pstate
......@@ -942,6 +979,14 @@ ed_Clear ps
= mb_update_undoinfo ps
ed_SelectAll ps
# (win,ps) = accPIO getActiveWindow ps
# (isPrjWin,ps) = case win of
Just wId -> isProjWin wId ps
_ -> (False,ps)
| isPrjWin
# (lbId,ps) = getPWI ps
# ps = setExtListBoxSelectionAll lbId ps