From b94d35919bbb1731fa7a46375b9161692c850c9c Mon Sep 17 00:00:00 2001 From: Dougal Date: Mon, 27 Nov 2023 11:08:03 -0500 Subject: [PATCH] Use explicit data structures to represent the AST on the browser side. Previously we baked the AST into the HTML tree which made it hard to change and add more information. --- src/lib/AbstractSyntax.hs | 22 ++-- src/lib/ConcreteSyntax.hs | 26 ++-- src/lib/Lexing.hs | 14 +- src/lib/Live/Eval.hs | 17 ++- src/lib/PPrint.hs | 2 +- src/lib/RenderHtml.hs | 6 +- src/lib/SourceIdTraversal.hs | 3 +- src/lib/Types/Source.hs | 5 +- static/index.js | 239 ++++++++++++++--------------------- 9 files changed, 156 insertions(+), 178 deletions(-) diff --git a/src/lib/AbstractSyntax.hs b/src/lib/AbstractSyntax.hs index 8d8ec9818..a21062ff1 100644 --- a/src/lib/AbstractSyntax.hs +++ b/src/lib/AbstractSyntax.hs @@ -195,7 +195,7 @@ withTrailingConstraints :: GroupW -> (GroupW -> SyntaxM (UAnnBinder VoidS VoidS)) -> SyntaxM (Nest UAnnBinder VoidS VoidS) withTrailingConstraints g cont = case g of - WithSrcs _ _ (CBin Pipe lhs c) -> do + WithSrcs _ _ (CBin (WithSrc _ Pipe) lhs c) -> do Nest (UAnnBinder expl (WithSrcB sid b) ann cs) bs <- withTrailingConstraints lhs cont s <- case b of UBindSource s -> return s @@ -253,7 +253,7 @@ explicitBindersOptAnn (WithSrcs _ _ bs) = -- Binder pattern with an optional type annotation patOptAnn :: GroupW -> SyntaxM (UPat VoidS VoidS, Maybe (UType VoidS)) -patOptAnn (WithSrcs _ _ (CBin Colon lhs typeAnn)) = (,) <$> pat lhs <*> (Just <$> expr typeAnn) +patOptAnn (WithSrcs _ _ (CBin (WithSrc _ Colon) lhs typeAnn)) = (,) <$> pat lhs <*> (Just <$> expr typeAnn) patOptAnn (WithSrcs _ _ (CParens [g])) = patOptAnn g patOptAnn g = (,Nothing) <$> pat g @@ -267,7 +267,7 @@ uBinder (WithSrcs sid _ b) = case b of tyOptPat :: GroupW -> SyntaxM (UAnnBinder VoidS VoidS) tyOptPat grpTop@(WithSrcs sid _ grp) = case grp of -- Named type - CBin Colon lhs typeAnn -> + CBin (WithSrc _ Colon) lhs typeAnn -> UAnnBinder Explicit <$> uBinder lhs <*> (UAnn <$> expr typeAnn) <*> pure [] -- Binder in grouping parens. CParens [g] -> tyOptPat g @@ -285,7 +285,7 @@ casePat = \case pat :: GroupW -> SyntaxM (UPat VoidS VoidS) pat (WithSrcs sid _ grp) = WithSrcB sid <$> case grp of - CBin DepComma lhs rhs -> do + CBin (WithSrc _ DepComma) lhs rhs -> do lhs' <- pat lhs rhs' <- pat rhs return $ UPatDepPair $ PairB lhs' rhs' @@ -317,8 +317,8 @@ pat (WithSrcs sid _ grp) = WithSrcB sid <$> case grp of tyOptBinder :: Explicitness -> GroupW -> SyntaxM (UAnnBinder VoidS VoidS) tyOptBinder expl (WithSrcs sid sids grp) = case grp of - CBin Pipe _ _ -> throw SyntaxErr "Unexpected constraint" - CBin Colon name ty -> do + CBin (WithSrc _ Pipe) _ _ -> throw SyntaxErr "Unexpected constraint" + CBin (WithSrc _ Colon) name ty -> do b <- uBinder name ann <- UAnn <$> expr ty return $ UAnnBinder expl b ann [] @@ -328,7 +328,7 @@ tyOptBinder expl (WithSrcs sid sids grp) = case grp of binderOptTy :: Explicitness -> GroupW -> SyntaxM (UAnnBinder VoidS VoidS) binderOptTy expl = \case - WithSrcs _ _ (CBin Colon name ty) -> do + WithSrcs _ _ (CBin (WithSrc _ Colon) name ty) -> do b <- uBinder name ann <- UAnn <$> expr ty return $ UAnnBinder expl b ann [] @@ -337,7 +337,7 @@ binderOptTy expl = \case return $ UAnnBinder expl b UNoAnn [] binderReqTy :: Explicitness -> GroupW -> SyntaxM (UAnnBinder VoidS VoidS) -binderReqTy expl (WithSrcs _ _ (CBin Colon name ty)) = do +binderReqTy expl (WithSrcs _ _ (CBin (WithSrc _ Colon) name ty)) = do b <- uBinder name ann <- UAnn <$> expr ty return $ UAnnBinder expl b ann [] @@ -348,7 +348,7 @@ argList gs = partitionEithers <$> mapM singleArg gs singleArg :: GroupW -> SyntaxM (Either (UExpr VoidS) (UNamedArg VoidS)) singleArg = \case - WithSrcs _ _ (CBin CSEqual lhs rhs) -> Right <$> + WithSrcs _ _ (CBin (WithSrc _ CSEqual) lhs rhs) -> Right <$> ((,) <$> withoutSrc <$> identifier "named argument" lhs <*> expr rhs) g -> Left <$> expr g @@ -450,7 +450,7 @@ expr (WithSrcs sid _ grp) = WithSrcE sid <$> case grp of args' <- mapM expr args return $ UTabApp f args' _ -> error "unexpected postfix group (should be ruled out at grouping stage)" - CBin op lhs rhs -> case op of + CBin (WithSrc opSid op) lhs rhs -> case op of Dollar -> extendAppRight <$> expr lhs <*> expr rhs Pipe -> extendAppLeft <$> expr lhs <*> expr rhs Dot -> do @@ -480,7 +480,7 @@ expr (WithSrcs sid _ grp) = WithSrcE sid <$> case grp of UTabPi . (UTabPiExpr lhs') <$> expr rhs where evalOp s = do - let f = WithSrcE (srcPos s) (fromSourceNameW s) + let f = WithSrcE opSid (fromSourceNameW (WithSrc opSid s)) lhs' <- expr lhs rhs' <- expr rhs return $ explicitApp f [lhs', rhs'] diff --git a/src/lib/ConcreteSyntax.hs b/src/lib/ConcreteSyntax.hs index 5762083ed..1d9a0c320 100644 --- a/src/lib/ConcreteSyntax.hs +++ b/src/lib/ConcreteSyntax.hs @@ -71,8 +71,8 @@ mustParseSourceBlock s = mustParseit s sourceBlock -- === helpers for target ADT === -interpOperator :: WithSrc String -> Bin -interpOperator (WithSrc sid s) = case s of +interpOperator :: String -> Bin +interpOperator = \case "&>" -> DepAmpersand "." -> Dot ",>" -> DepComma @@ -83,7 +83,7 @@ interpOperator (WithSrc sid s) = case s of "->>" -> ImplicitArrow "=>" -> FatArrow "=" -> CSEqual - name -> EvalBinOp $ WithSrc sid $ fromString $ "(" <> name <> ")" + name -> EvalBinOp $ fromString $ "(" <> name <> ")" pattern Identifier :: SourceName -> GroupW pattern Identifier name <- (WithSrcs _ _ (CLeaf (CIdentifier name))) @@ -477,7 +477,9 @@ cFor = do <|> keyWord Rof_KW $> KRof_ cDo :: Parser Group -cDo = CDo <$> cBlock +cDo = do + keyWord DoKW + CDo <$> cBlock cCase :: Parser Group cCase = do @@ -584,9 +586,9 @@ leafGroup = leafGroup' >>= appendPostfixGroups appendFieldAccess :: GroupW -> Parser Group appendFieldAccess g = try do - void $ char '.' + sid <- dot field <- cFieldName - return $ CBin Dot g field + return $ CBin (WithSrc sid Dot) g field cFieldName :: Parser GroupW cFieldName = cIdentifier <|> (toCLeaf CNat <$> natLit) @@ -675,13 +677,13 @@ addSrcIdToUnOp op = do backquoteOp :: Parser (GroupW -> GroupW -> GroupW) backquoteOp = binApp do - fname <- backquoteName - return $ EvalBinOp fname + WithSrc sid fname <- backquoteName + return $ WithSrc sid $ EvalBinOp fname anySymOp :: Expr.Operator Parser GroupW anySymOp = Expr.InfixL $ binApp do - s <- label "infix operator" (mayBreak anySym) - return $ interpOperator s + WithSrc sid s <- label "infix operator" (mayBreak anySym) + return $ WithSrc sid $ interpOperator s infixSym :: String -> Parser SrcId infixSym s = mayBreak $ symWithId $ T.pack s @@ -698,7 +700,7 @@ symOpR s = (fromString s, Expr.InfixR $ symOp s) symOp :: String -> Parser (GroupW -> GroupW -> GroupW) symOp s = binApp do sid <- label "infix operator" (infixSym s) - return $ interpOperator (WithSrc sid s) + return $ WithSrc sid $ interpOperator s arrowOp :: Parser (GroupW -> GroupW -> GroupW) arrowOp = addSrcIdToBinOp do @@ -714,7 +716,7 @@ prefixOp s = addSrcIdToUnOp do symId <- symWithId (fromString s) return $ CPrefix (WithSrc symId $ fromString s) -binApp :: Parser Bin -> Parser (GroupW -> GroupW -> GroupW) +binApp :: Parser BinW -> Parser (GroupW -> GroupW -> GroupW) binApp f = addSrcIdToBinOp $ CBin <$> f withClausePostfixOp :: Parser (GroupW -> GroupW) diff --git a/src/lib/Lexing.hs b/src/lib/Lexing.hs index 18c85f55d..4d3b6dc8e 100644 --- a/src/lib/Lexing.hs +++ b/src/lib/Lexing.hs @@ -216,6 +216,10 @@ symChar = token (\c -> if HS.member c symChars then Just c else Nothing) mempty symChars :: HS.HashSet Char symChars = HS.fromList ".,!$^&*:-~+/=<>|?\\@#" +-- XXX: unlike other lexemes, this doesn't consume trailing whitespace +dot :: Parser SrcId +dot = srcPos <$> lexeme' (return ()) Symbol (void $ char '.') + -- === Util === sc :: Parser () @@ -349,18 +353,22 @@ symbol :: Text -> Parser () symbol s = void $ L.symbol sc s lexeme :: LexemeType -> Parser a -> Parser (WithSrc a) -lexeme lexemeType p = do +lexeme lexemeType p = lexeme' sc lexemeType p +{-# INLINE lexeme #-} + +lexeme' :: Parser () -> LexemeType -> Parser a -> Parser (WithSrc a) +lexeme' sc' lexemeType p = do start <- getOffset ans <- p end <- getOffset recordNonWhitespace - sc + sc' sid <- freshSrcId emitLexemeInfo $ mempty { lexemeList = toSnocList [sid] , lexemeInfo = M.singleton sid (lexemeType, (start, end)) } return $ WithSrc sid ans -{-# INLINE lexeme #-} +{-# INLINE lexeme' #-} atomicLexeme :: LexemeType -> Parser () -> Parser () atomicLexeme lexemeType p = do diff --git a/src/lib/Live/Eval.hs b/src/lib/Live/Eval.hs index f5248302f..5363a2ee2 100644 --- a/src/lib/Live/Eval.hs +++ b/src/lib/Live/Eval.hs @@ -28,6 +28,7 @@ import TopLevel import ConcreteSyntax import RenderHtml (ToMarkup, pprintHtml) import MonadUtil +import Util (unsnoc) -- === Top-level interface === @@ -305,10 +306,24 @@ instance (ToJSON a, ToJSONKey k) => ToJSON (MapUpdate k a) instance ToJSON a => ToJSON (TailUpdate a) instance ToJSON a => ToJSON (MapEltUpdate a) instance ToJSON o => ToJSON (NodeEvalStatus o) +instance ToJSON SrcId +deriving instance ToJSONKey SrcId +instance ToJSON ASTInfo +instance ToJSON LexemeType instance (ToJSON i, ToJSON o) => ToJSON (NodeState i o) +data SourceBlockJSONData = SourceBlockJSONData + { jdLine :: Int + , jdBlockId :: Int + , jdLexemeList :: [SrcId] + , jdASTInfo :: ASTInfo + , jdHTML :: String } deriving (Generic) + +instance ToJSON SourceBlockJSONData + instance ToJSON SourceBlockWithId where - toJSON b@(SourceBlockWithId _ b') = toJSON (sbLine b', pprintHtml b) + toJSON b@(SourceBlockWithId blockId b') = toJSON $ SourceBlockJSONData + (sbLine b') blockId (unsnoc $ lexemeList $ sbLexemeInfo b') (sbASTInfo b') (pprintHtml b) instance ToJSON Result where toJSON = toJSONViaHtml toJSONViaHtml :: ToMarkup a => a -> Value diff --git a/src/lib/PPrint.hs b/src/lib/PPrint.hs index bac0e3bbe..9add7af52 100644 --- a/src/lib/PPrint.hs +++ b/src/lib/PPrint.hs @@ -1084,7 +1084,7 @@ instance PrettyPrec Group where -- prettyPrec g = atPrec ArgPrec $ fromString $ show g instance Pretty Bin where - pretty (EvalBinOp name) = pretty (withoutSrc name) + pretty (EvalBinOp name) = pretty name pretty DepAmpersand = "&>" pretty Dot = "." pretty DepComma = ",>" diff --git a/src/lib/RenderHtml.hs b/src/lib/RenderHtml.hs index 7e4aac451..bc4809a41 100644 --- a/src/lib/RenderHtml.hs +++ b/src/lib/RenderHtml.hs @@ -76,7 +76,7 @@ instance ToMarkup Output where instance ToMarkup SourceBlockWithId where toMarkup (SourceBlockWithId blockId block) = case sbContents block of Misc (ProseBlock s) -> cdiv "prose-block" $ mdToHtml s - _ -> renderSpans blockId (sbLexemeInfo block) (sbASTInfo block) (sbText block) + _ -> renderSpans blockId (sbLexemeInfo block) (sbText block) mdToHtml :: T.Text -> Html mdToHtml s = preEscapedText $ commonmarkToHtml [] s @@ -86,8 +86,8 @@ cdiv c inner = H.div inner ! class_ (stringValue c) type BlockId = Int -renderSpans :: BlockId -> LexemeInfo -> ASTInfo -> T.Text -> Markup -renderSpans blockId lexInfo astInfo sourceText = cdiv "code-block" do +renderSpans :: BlockId -> LexemeInfo -> T.Text -> Markup +renderSpans blockId lexInfo sourceText = cdiv "code-block" do runTextWalkerT sourceText do forM_ (lexemeList lexInfo) \sourceId -> do let (lexemeTy, (l, r)) = fromJust $ M.lookup sourceId (lexemeInfo lexInfo) diff --git a/src/lib/SourceIdTraversal.hs b/src/lib/SourceIdTraversal.hs index 1fb33a50f..565027294 100644 --- a/src/lib/SourceIdTraversal.hs +++ b/src/lib/SourceIdTraversal.hs @@ -49,7 +49,7 @@ instance IsTree Group where CPrim _ xs -> mapM_ visit xs CParens xs -> mapM_ visit xs CBrackets xs -> mapM_ visit xs - CBin _ l r -> visit l >> visit r + CBin b l r -> visit b >> visit l >> visit r CJuxtapose _ l r -> visit l >> visit r CPrefix l r -> visit l >> visit r CGivens (x,y) -> visit x >> visit y @@ -111,3 +111,4 @@ instance (IsTree a, IsTree b, IsTree c) => IsTree (a, b, c) where instance IsTree AppExplicitness where visit _ = return () instance IsTree SourceName where visit _ = return () instance IsTree LetAnn where visit _ = return () +instance IsTree Bin where visit _ = return () diff --git a/src/lib/Types/Source.hs b/src/lib/Types/Source.hs index 81f1c3387..5c01c3f37 100644 --- a/src/lib/Types/Source.hs +++ b/src/lib/Types/Source.hs @@ -100,6 +100,7 @@ type GroupW = WithSrcs Group type CTopDeclW = WithSrcs CTopDecl type CSDeclW = WithSrcs CSDecl type SourceNameW = WithSrc SourceName +type BinW = WithSrc Bin type BracketedGroup = WithSrcs [GroupW] -- optional arrow, effects, result type @@ -161,7 +162,7 @@ data Group | CPrim PrimName [GroupW] | CParens [GroupW] | CBrackets [GroupW] - | CBin Bin GroupW GroupW + | CBin BinW GroupW GroupW | CJuxtapose Bool GroupW GroupW -- Bool means "there's a space between the groups" | CPrefix SourceNameW GroupW -- covers unary - and unary + among others | CGivens GivenClause @@ -187,7 +188,7 @@ data CLeaf type CaseAlt = (GroupW, CSBlock) -- scrutinee, lexeme Id, body data Bin - = EvalBinOp SourceNameW + = EvalBinOp SourceName | DepAmpersand | Dot | DepComma diff --git a/static/index.js b/static/index.js index 1d2c36a5a..7657b3024 100644 --- a/static/index.js +++ b/static/index.js @@ -16,53 +16,6 @@ var katexOptions = { trust: true }; -function lookup_address(cell, address) { - var node = cell - for (i = 0; i < address.length; i++) { - node = node.children[address[i]] - } - return node -} - -function renderHovertips(root) { - var spans = root.querySelectorAll(".code-span"); - Array.from(spans).map((span) => attachHovertip(span)); -} - -function attachHovertip(node) { - node.addEventListener("mouseover", (event) => highlightNode( event, node)); - node.addEventListener("mouseout" , (event) => removeHighlighting(event, node)); -} - -function highlightNode(event, node) { - event.stopPropagation(); - node.style.backgroundColor = "lightblue"; - node.style.outlineColor = "lightblue"; - node.style.outlineStyle = "solid"; - Array.from(node.children).map(function (child) { - if (isCodeSpanOrLeaf(child)) { - child.style.backgroundColor = "yellow"; - } - }) -} - -function isCodeSpanOrLeaf(node) { - return node.classList.contains("code-span") || node.classList.contains("code-span-leaf") - -} - -function removeHighlighting(event, node) { - event.stopPropagation(); - node.style.backgroundColor = null; - node.style.outlineColor = null; - node.style.outlineStyle = null; - Array.from(node.children).map(function (child) { - if (isCodeSpanOrLeaf(child)) { - child.style.backgroundColor = null; - } - }) -} - function renderLaTeX(root) { // Render LaTeX equations in prose blocks via KaTeX, if available. // Skip rendering if KaTeX is unavailable. @@ -76,84 +29,6 @@ function renderLaTeX(root) { ); } -/** - * Rendering the Table of Contents / Navigation Bar - * 2 key functions - * - `updateNavigation()` which inserts/updates the navigation bar - * - and its helper `extractStructure()` which extracts the structure of the page - * and adds ids to heading elements. -*/ -function updateNavigation() { - function navItemList(struct) { - var listEle = document.createElement('ol') - struct.children.forEach(childStruct=> - listEle.appendChild(navItem(childStruct)) - ); - return listEle; - } - function navItem(struct) { - var a = document.createElement('a'); - a.appendChild(document.createTextNode(struct.text)); - a.title = struct.text; - a.href = "#"+struct.id; - - var ele = document.createElement('li') - ele.appendChild(a) - ele.appendChild(navItemList(struct)); - return ele; - } - - var navbarEle = document.getElementById("navbar") - if (navbarEle === null) { // create it - navbarEle = document.createElement("div"); - navbarEle.id="navbar"; - navOuterEle = document.createElement("nav") - navOuterEle.appendChild(navbarEle); - document.body.prepend(navOuterEle); - } - - navbarEle.innerHTML = "" - var structure = extractStructure() - navbarEle.appendChild(navItemList(structure)); -} - -function extractStructure() { // Also sets ids on h1,h2,... - var headingsNodes = document.querySelectorAll("h1, h2, h3, h4, h5, h6"); - // For now we are just fulling going to regenerate the structure each time - // Might be better if we made minimal changes, but 🤷 - - // Extract the structure of the document - var structure = {children:[]} - var active = [structure.children]; - headingsNodes.forEach( - function(currentValue, currentIndex) { - currentValue.id = "s-" + currentIndex; - var currentLevel = parseInt(currentValue.nodeName[1]); - - // Insert dummy levels up for any levels that are skipped - for (var i=active.length; i < currentLevel; i++) { - var dummy = {id: "", text: "", children: []} - active.push(dummy.children); - var parentList = active[i-1] - parentList.push(dummy); - } - // delete this level and everything after - active.splice(currentLevel, active.length); - - var currentStructure = { - id: currentValue.id, - text: currentValue.textContent, - children: [], - }; - active.push(currentStructure.children); - - var parentList = active[active.length-2] - parentList.push(currentStructure); - }, - ); - return structure; -} - /** * HTML rendering mode. * Static rendering is used for static HTML pages. @@ -178,8 +53,6 @@ function render(renderMode) { if (renderMode == RENDER_MODE.STATIC) { // For static pages, simply call rendering functions once. renderLaTeX(document); - renderHovertips(document); - updateNavigation(); } else { // For dynamic pages (via `dex web`), listen to update events. var source = new EventSource("/getnext"); @@ -190,24 +63,88 @@ function render(renderMode) { cells = {} return } else { - process_update(msg); + processUpdate(msg); } }; } } -function set_cell_contents(cell, contents) { - var line_num = contents[0][0]; - var source_text = contents[0][1]; - var line_num_div = document.createElement("div"); +function selectSpan(cellCtx, srcId) { + let [cell, blockId, _] = cellCtx + return cell.querySelector("#span_".concat(blockId.toString(), "_", srcId.toString()));} + +function attachHovertip(cellCtx, srcId) { + let span = selectSpan(cellCtx, srcId); + span.addEventListener("mouseover", (event) => enterSpan(event, cellCtx, srcId)); + span.addEventListener("mouseout" , (event) => leaveSpan(event, cellCtx, srcId));} + +function getParent(cellCtx, srcId) { + let [ , , astInfo] = cellCtx; + let parent = astInfo["astParent"][srcId.toString()] + if (parent == undefined) { + console.error(srcId, astInfo); + throw new Error("Can't find parent"); + } else { + return parent; + }} + +function getChildren(cellCtx, srcId) { + let [ , , astInfo] = cellCtx; + let children = astInfo["astChildren"][srcId.toString()] + if (children == undefined) { + return []; + } else { + return children; + }} + +function traverseSpans(cellCtx, srcId, f) { + let span = selectSpan(cellCtx, srcId) + if (span !== null) f(span); + getChildren(cellCtx, srcId).map(function (childId) { + traverseSpans(cellCtx, childId, f); + })} - line_num_div.innerHTML = line_num.toString(); - line_num_div.className = "line-num"; +function enterSpan(event, cellCtx, srcId) { + event.stopPropagation(); + let parentId = getParent(cellCtx, srcId); + traverseSpans(cellCtx, parentId, function (span) { + span.style.backgroundColor = "lightblue"; + span.style.outlineColor = "lightblue"; + span.style.outlineStyle = "solid"; + }); + let siblingIds = getChildren(cellCtx, parentId); + siblingIds.map(function (siblingId) { + traverseSpans(cellCtx, siblingId, function (span) { + span.style.backgroundColor = "yellow"; + })})} + +function leaveSpan(event, cellCtx, srcId) { + event.stopPropagation(); + let parentId = getParent(cellCtx, srcId); + traverseSpans(cellCtx, parentId, function (span) { + span.style.backgroundColor = null; + span.style.outlineColor = null; + span.style.outlineStyle = null; + }); + let siblingIds = getChildren(cellCtx, parentId); + siblingIds.map(function (siblingId) { + traverseSpans(cellCtx, siblingId, function (span) { + span.style.backgroundColor = null; + })})} + +function setCellContents(cell, contents) { + let source = contents[0]; + let results = contents[1]; + let lineNum = source["jdLine"]; + let sourceText = source["jdHTML"]; + let lineNumDiv = document.createElement("div"); + lineNumDiv.innerHTML = lineNum.toString(); + lineNumDiv.className = "line-num"; cell.innerHTML = "" - cell.appendChild(line_num_div); - cell.innerHTML += source_text - var results = contents[1]; - tag = results["tag"] + cell.appendChild(lineNumDiv); + cell.innerHTML += sourceText + + tag = results["tag"] if (tag == "Waiting") { cell.className = "cell waiting-cell"; } else if (tag == "Running") { @@ -219,10 +156,9 @@ function set_cell_contents(cell, contents) { console.error(tag); } renderLaTeX(cell); - renderHovertips(cell); } -function process_update(msg) { +function processUpdate(msg) { var cell_updates = msg["nodeMapUpdate"]["mapUpdates"]; var num_dropped = msg["orderedNodesUpdate"]["numDropped"]; var new_tail = msg["orderedNodesUpdate"]["newTail"]; @@ -238,10 +174,10 @@ function process_update(msg) { if (tag == "Create") { var cell = document.createElement("div"); cells[node_id] = cell; - set_cell_contents(cell, contents) + setCellContents(cell, contents) } else if (tag == "Update") { var cell = cells[node_id]; - set_cell_contents(cell, contents); + setCellContents(cell, contents); } else if (tag == "Delete") { delete cells[node_id] } else { @@ -251,7 +187,22 @@ function process_update(msg) { // append_new_cells new_tail.forEach(function (node_id) { - body.appendChild(cells[node_id]); - }); + cell = cells[node_id]; + body.appendChild(cell); + }) + // add hovertips + new_tail.forEach(function (node_id) { + cell = cells[node_id]; + var update = cell_updates[node_id]; + if (update["tag"] == "Create") { + var source = update["contents"][0]; + var blockId = source["jdBlockId"]; + var astInfo = source["jdASTInfo"]; + var lexemeList = source["jdLexemeList"]; + cellCtx = [cell, blockId, astInfo]; + lexemeList.map(function (lexemeId) {attachHovertip(cellCtx, lexemeId)}) + } + }); } +