Merge pull request #19 from cryogenian/readonly

cryogenian · cryogenian · commit 108bc838d2e1 · 2016-01-25T23:46:13.000+03:00
Readonly
diff --git a/bower.json b/bower.json
@@ -27,6 +27,7 @@
     "purescript-prelude": "^0.1.3"
   },
   "devDependencies": {
-    "ace-builds": "~1.2.0"
+    "ace-builds": "~1.2.0",
+    "purescript-refs": "~0.2.0"
   }
 }
diff --git a/example/index.html b/example/index.html
@@ -10,6 +10,11 @@
         bottom: 0;
         left: 0;
     }
+    .readonly-highlight {
+      background-color: red;
+      opacity: 0.2;
+      position: absolute;
+    }
   </style>
   <script src="../bower_components/ace-builds/src-min/ace.js"
           type="text/javascript"
diff --git a/example/src/Main.purs b/example/src/Main.purs
@@ -4,12 +4,13 @@ import Prelude
 
 import Data.Maybe
 import Data.Array.ST (pushSTArray)
+import DOM (DOM())
 
 import Control.Monad.Eff
 import Control.Monad.Eff.Console (print, log, CONSOLE())
+import Control.Monad.Eff.Ref (newRef, readRef, writeRef, REF())
 
 import Ace
-import Ace.Types
 
 import Ace.Config as Config
 import Ace.Editor as Editor
@@ -21,23 +22,83 @@ import Ace.Range as Range
 import Ace.ScrollBar as ScrollBar
 import Ace.Search as Search
 import Ace.Selection as Selection
-import Ace.Tokenizer as Tokenizer
 import Ace.TokenIterator as TokenIterator
 import Ace.UndoManager as UndoManager
-import Ace.VirtualRenderer as VirtualRenderer
 import Ace.Ext.LanguageTools as LanguageTools
 import Ace.Ext.LanguageTools.Completer as Completer
+import Ace.KeyBinding as KeyBinding
 
 foreign import rules :: Rules
 foreign import onLoad :: forall e. Eff e Unit -> Eff e Unit
 
-main :: Eff (ace :: ACE, console :: CONSOLE) Unit
+main :: forall e. Eff (ref ::REF, console :: CONSOLE, ace :: ACE, dom :: DOM|e) Unit
 main = onLoad $ do
-
   Config.set Config.basePath "foo"
 
   -- Create an editor
   editor <- Ace.edit "editor" ace
+  session <- Editor.getSession editor
+  document <- Session.getDocument session
+  Editor.setValue "blablabla \n tr  test boo boo" Nothing editor
+
+  startAnchor <- Document.createAnchor 1 5 document
+  endAnchor <- Document.createAnchor 1 9 document
+  Anchor.setInsertRight true endAnchor
+
+  range <- Range.create 1 4 1 10
+  markerRef <-
+    Session.addMarker
+      range
+      "readonly-highlight"
+      "string"
+      false
+      session
+    >>= newRef
+
+  let rerenderMarker _ = do
+        readRef markerRef >>= flip Session.removeMarker session
+        Position {row: startRow, column: startColumn}
+          <- Anchor.getPosition startAnchor
+        Position {row: endRow, column: endColumn}
+          <- Anchor.getPosition endAnchor
+        markRange <- Range.create
+                       startRow
+                       (startColumn - one)
+                       endRow
+                       (endColumn + one)
+        newMId <- Session.addMarker
+                  markRange
+                  "readonly-highlight"
+                  "string"
+                  false
+                  session
+
+        writeRef markerRef newMId
+        pure unit
+
+  Anchor.onChange startAnchor rerenderMarker
+  Anchor.onChange endAnchor rerenderMarker
+
+  Editor.getKeyBinding editor
+    >>= KeyBinding.addKeyboardHandler \{editor} hs kstring kcode evt -> do
+      if hs == -1 || (kcode <= 40 && kcode >= 37)
+        then pure Nothing
+        else do
+        Position {row: startRow, column: startColumn}
+          <- Anchor.getPosition startAnchor
+        Position {row: endRow, column: endColumn}
+          <- Anchor.getPosition endAnchor
+        selectedRange <- Editor.getSelectionRange editor
+        newRange <-
+          if kstring == "backspace"
+          then Range.create startRow startColumn endRow (endColumn + 1)
+          else if kstring == "delete" || (kstring == "d" && hs == 1)
+               then Range.create startRow (startColumn - 1) endRow endColumn
+               else Range.create startRow startColumn endRow endColumn
+        intersected <- Range.intersects newRange selectedRange
+        pure if intersected
+             then Just {command: Null, passEvent: false}
+             else Nothing
 
   -- Set the theme
   Editor.setTheme "ace/theme/chrome" editor
@@ -49,7 +110,7 @@ main = onLoad $ do
   editor `Editor.onFocus` log "Editor gained focus."
 
   -- Get the editor session
-  session <- Editor.getSession editor
+
 
   -- Set the mode
   Session.setMode "ace/mode/javascript" session
@@ -149,10 +210,11 @@ main = onLoad $ do
 
   -- Misc. Tests
   miscTests
+
   pure unit
 
 
-miscTests :: Eff (console :: CONSOLE, ace :: ACE) Unit
+miscTests :: forall e. Eff (console :: CONSOLE, ace :: ACE |e) Unit
 miscTests = void do
   editor <- Ace.edit "tests" ace
   session <- Editor.getSession editor
diff --git a/src/Ace/Anchor.js b/src/Ace/Anchor.js
@@ -42,3 +42,18 @@ exports.createImpl = function(doc, row, column) {
     };
 };
 
+
+exports.getInsertRight = function(a) {
+    return function() {
+        return a.$insertRight;
+    };
+};
+
+exports.setInsertRight = function(val) {
+    return function(a) {
+        return function() {
+            a.$insertRight = val;
+            return {};
+        };
+    };
+};
diff --git a/src/Ace/Anchor.purs b/src/Ace/Anchor.purs
@@ -5,6 +5,8 @@ module Ace.Anchor
   , setPosition
   , detach
   , create
+  , getInsertRight
+  , setInsertRight
   ) where
 
 import Prelude
@@ -43,3 +45,8 @@ foreign import createImpl :: forall eff. Fn3 Document Int Int (Eff (ace :: ACE |
 
 create :: forall eff. Document -> Int -> Int -> Eff (ace :: ACE | eff) Anchor
 create doc row column = runFn3 createImpl doc row column
+
+foreign import getInsertRight :: forall eff. Anchor -> Eff (ace :: ACE |eff) Boolean
+foreign import setInsertRight
+  :: forall eff
+   . Boolean -> Anchor -> Eff (ace :: ACE|eff) Unit
diff --git a/src/Ace/Command.purs b/src/Ace/Command.purs
@@ -0,0 +1,7 @@
+module Ace.Command where
+
+import Ace.Types (Command(..))
+
+commandToString :: Command -> String
+commandToString Null = "null"
+commandToString InsertText = "inserttext"
diff --git a/src/Ace/EditSession.js b/src/Ace/EditSession.js
@@ -551,3 +551,16 @@ exports.createWithModeImpl = create;
 exports.createImpl = create;
 
 exports.createFromLinesImpl = create;
+
+exports.getMarkers = function(session) {
+    return function() {
+        var markerObj = session.getMarkers();
+        var i, ks = Object.getOwnPropertyNames(markerObj),
+            key, result = [];
+        for (i = 0; i < ks.length; i++) {
+            key = ks[i];
+            result.push(markerObj[key]);
+        }
+        return result;
+    };
+};
diff --git a/src/Ace/EditSession.purs b/src/Ace/EditSession.purs
@@ -104,6 +104,7 @@ module Ace.EditSession
   , setValue
   , setWrapLimitRange
   , toggleOverwrite
+  , getMarkers
   ) where
 
 import Prelude
@@ -293,9 +294,9 @@ foreign import clearBreakpointImpl :: forall eff. Fn2 Int EditSession (Eff (ace
 clearBreakpoint :: forall eff. Int -> EditSession -> Eff (ace :: ACE | eff) Unit
 clearBreakpoint row self = runFn2 clearBreakpointImpl row self
 
-foreign import addMarkerImpl :: forall eff. Fn5 Range String String Boolean EditSession (Eff (ace :: ACE | eff) Unit)
+foreign import addMarkerImpl :: forall eff. Fn5 Range String String Boolean EditSession (Eff (ace :: ACE | eff) Int)
 
-addMarker :: forall eff. Range -> String -> String -> Boolean -> EditSession -> Eff (ace :: ACE | eff) Unit
+addMarker :: forall eff. Range -> String -> String -> Boolean -> EditSession -> Eff (ace :: ACE | eff) Int
 addMarker range clazz _type inFront self = runFn5 addMarkerImpl range clazz _type inFront self
 
 type DynamicMarker eff a = forall h. STArray h String -> HTMLElement -> Eff (st :: ST h | eff) a
@@ -534,3 +535,7 @@ foreign import createFromLinesImpl :: forall eff. Fn2 (Array String) (Nullable S
 
 createFromLines :: forall eff. Array String -> Maybe String -> Eff (ace :: ACE | eff) EditSession
 createFromLines text mode' = runFn2 createFromLinesImpl text (toNullable mode')
+
+
+foreign import getMarkers
+  :: forall eff. EditSession -> Eff (ace :: ACE |eff) (Array Marker)
diff --git a/src/Ace/Editor.js b/src/Ace/Editor.js
@@ -166,3 +166,9 @@ exports.createImpl = function(renderer, session) {
         return new Editor(renderer, session);
     };
 };
+
+exports.getKeyBinding = function(editor) {
+    return function() {
+        return editor.keyBinding;
+    };
+};
diff --git a/src/Ace/Editor.purs b/src/Ace/Editor.purs
@@ -125,6 +125,7 @@ module Ace.Editor
   , setEnableLiveAutocompletion
   , setEnableBasicAutocompletion
   , setEnableSnippets
+  , getKeyBinding
   ) where
 
 import Prelude
@@ -681,3 +682,7 @@ setEnableLiveAutocompletion = setOption "enableLiveAutocompletion"
 setEnableSnippets
   :: forall eff. Boolean -> Editor -> Eff (ace :: ACE | eff) Unit
 setEnableSnippets = setOption "enableSnippets"
+
+
+foreign import getKeyBinding
+  :: forall eff. Editor -> Eff (ace :: ACE | eff) KeyBinding
diff --git a/src/Ace/KeyBinding.js b/src/Ace/KeyBinding.js
@@ -0,0 +1,31 @@
+"use strict";
+/* global exports */
+// module Ace.KeyBinding
+
+exports.addKeyboardHandlerImpl = function(commandToString) {
+    return function(isJust) {
+        return function(fromJust) {
+            return function(curriedEffHandler) {
+                return function(kb) {
+                    return function() {
+                        kb.addKeyboardHandler(
+                            function(data, hash, keyCode, keyString, evt) {
+                                var res = curriedEffHandler(data)(hash)(keyCode)(keyString)(evt)(),
+                                    extracted;
+                                if (isJust(res)) {
+                                    extracted = fromJust(res);
+                                    return {
+                                        passEvent: extracted.passEvent,
+                                        command: commandToString(extracted.command)
+                                    };
+                                } else {
+                                    return false;
+                                }
+                            });
+                        return {};
+                    };
+                };
+            };
+        };
+    };
+};
diff --git a/src/Ace/KeyBinding.purs b/src/Ace/KeyBinding.purs
@@ -0,0 +1,33 @@
+module Ace.KeyBinding where
+
+import Prelude
+import Ace.Types
+import Ace.Command (commandToString)
+import Data.Maybe (Maybe(), isJust)
+import Data.Maybe.Unsafe (fromJust)
+import DOM.Event.Types (KeyboardEvent())
+import Control.Monad.Eff (Eff())
+
+type KeyboardHandler e =
+  { editor :: Editor }
+  -> Int
+  -> String
+  -> Int
+  -> KeyboardEvent
+  -> Eff e (Maybe HandlerResult)
+
+foreign import addKeyboardHandlerImpl
+  :: forall e a
+   . (Command -> String)
+  -> (Maybe a -> Boolean)
+  -> (Maybe a -> a)
+  -> KeyboardHandler (ace :: ACE|e)
+  -> KeyBinding
+  -> Eff (ace :: ACE|e) Unit
+
+addKeyboardHandler
+  :: forall e
+   . KeyboardHandler (ace :: ACE |e)
+  -> KeyBinding
+  -> Eff (ace :: ACE|e) Unit
+addKeyboardHandler = addKeyboardHandlerImpl commandToString isJust fromJust
diff --git a/src/Ace/Marker.js b/src/Ace/Marker.js
@@ -0,0 +1,43 @@
+"use strict";
+/* global exports */
+// module Ace.Marker
+
+exports.getId = function(m) {
+    return function() {
+        return m.id;
+    };
+};
+
+exports.getClazz = function(m) {
+    return function() {
+        return m.clazz;
+    };
+};
+
+exports.getInFront = function(m) {
+    return function() {
+        return m.inFront;
+    };
+};
+
+exports.getType = function(m) {
+    return function() {
+        return m.type;
+    };
+};
+
+exports.getRangeImpl = function(Nothing) {
+    return function(Just) {
+        return function(m) {
+            return function() {
+                var res = m.range;
+                if (typeof res === "undefined") {
+                    return Nothing;
+                }
+                else {
+                    return Just(res);
+                }
+            };
+        };
+    };
+};
diff --git a/src/Ace/Marker.purs b/src/Ace/Marker.purs
@@ -0,0 +1,22 @@
+module Ace.Marker (
+    getId
+  , getClazz
+  , getInFront
+  , getType
+  , getRange
+  ) where
+
+import Ace.Types
+import Data.Maybe (Maybe(..))
+import Control.Monad.Eff (Eff())
+
+foreign import getId :: forall e. Marker -> Eff (ace :: ACE|e) Int
+foreign import getClazz :: forall e. Marker -> Eff (ace :: ACE|e) String
+foreign import getInFront :: forall e. Marker -> Eff (ace :: ACE|e) Boolean
+foreign import getType :: forall e. Marker -> Eff (ace :: ACE|e) String
+foreign import getRangeImpl
+  :: forall e a
+   . Maybe a -> (a -> Maybe a) -> Marker -> Eff (ace :: ACE|e) (Maybe Range)
+
+getRange :: forall e. Marker -> Eff (ace :: ACE|e) (Maybe Range)
+getRange = getRangeImpl Nothing Just
diff --git a/src/Ace/Range.purs b/src/Ace/Range.purs
diff --git a/src/Ace/Types.purs b/src/Ace/Types.purs

Original file line number	Diff line number	Diff line change
`@@ -27,6 +27,7 @@`
`27`	`27`	`"purescript-prelude": "^0.1.3"`
`28`	`28`	`},`
`29`	`29`	`"devDependencies": {`
`30`		`- "ace-builds": "~1.2.0"`
	`30`	`+ "ace-builds": "~1.2.0",`
	`31`	`+ "purescript-refs": "~0.2.0"`
`31`	`32`	`}`
`32`	`33`	`}`