Merge pull request mozart#135 from yjaradin/fixBufferSwitching

Added support for switching OPI buffer to emulator
yjaradin · Feb 9, 2014 · f4322eb · f4322eb
2 parents 2f2d000 + d737f2d
commit f4322eb
Show file tree

Hide file tree

Showing 6 changed files with 28 additions and 4 deletions.
diff --git a/opi/opi/Emacs.oz b/opi/opi/Emacs.oz
@@ -33,12 +33,14 @@ export
    getOPI:    GetOPI
    condSend:  CondSend
    interface: CompilerInterfaceEmacs
+   attentionPrefix: MSG_ERROR
 define
    TimeoutToConfigBar = 200
    TimeoutToUpdateBar = TimeoutToConfigBar
 
+   MSG_ERROR = [17]
+
    local
-      MSG_ERROR = [17]
 
       class TextSocket from Open.socket Open.text
          prop final

diff --git a/opi/opi/OPI.oz b/opi/opi/OPI.oz
@@ -34,7 +34,7 @@ import
    OS(getEnv)
    Open(file)
    Compiler(engine)
-   Emacs(interface)
+   Emacs(interface attentionPrefix)
    OPIEnv(full)
 export
    compiler: OPICompiler
@@ -54,6 +54,7 @@ define
    end
 
    {Property.put 'oz.standalone' false}
+   {Property.put 'errors.prefix' Emacs.attentionPrefix}
 
    OPICompiler = {New Compiler.engine init()}
    {OPICompiler enqueue(mergeEnv(OPIEnv.full))}

diff --git a/vm/vm/main/modules/modsystem.hh b/vm/vm/main/modules/modsystem.hh
@@ -117,6 +117,15 @@ public:
         ozVSGet(vm, value, valueBufSize, valueStr);
 
         auto& stream = boolToStdErr ? std::cerr : std::cout;
+
+        if (boolToStdErr) {
+          StableNode* prefix = vm->getPropertyRegistry().config.errorPrefix;
+          size_t prefixBufSize = ozVSLengthForBuffer(vm, *prefix);
+          std::string prefixStr;
+          ozVSGet(vm, *prefix, prefixBufSize, prefixStr);
+          stream << prefixStr;
+        }
+
         stream << valueStr;
         if (boolNewLine)
           stream << std::endl;

diff --git a/vm/vm/main/properties-decl.hh b/vm/vm/main/properties-decl.hh
@@ -162,6 +162,7 @@ public:
 
     // Errors
     StableNode* defaultExceptionHandler;
+    StableNode* errorPrefix;
     bool errorsDebug;
     nativeint errorsDepth;
     nativeint errorsWidth;

diff --git a/vm/vm/main/properties.cc b/vm/vm/main/properties.cc
@@ -43,8 +43,8 @@ void PropertyRegistry::initConfig(VM vm) {
 
   // Errors
 
-  config.defaultExceptionHandler = new (vm) StableNode;
-  config.defaultExceptionHandler->init(vm, buildNil(vm));
+  config.defaultExceptionHandler = new (vm) StableNode(vm, buildNil(vm));
+  config.errorPrefix = new (vm) StableNode(vm, buildNil(vm));
 
   config.errorsDebug = true;
   config.errorsDepth = 10;
@@ -93,6 +93,15 @@ void PropertyRegistry::registerPredefined(VM vm) {
     }
   );
 
+  registerProp(vm, "errors.prefix",
+    [this] (VM vm) -> UnstableNode {
+      return { vm, *config.errorPrefix };
+    },
+    [this] (VM vm, RichNode value) {
+      config.errorPrefix = value.getStableRef(vm);
+    }
+  );
+
   registerReadWriteProp(vm, "errors.debug", config.errorsDebug);
   registerReadWriteProp(vm, "errors.depth", config.errorsDepth);
   registerReadWriteProp(vm, "errors.width", config.errorsWidth);

diff --git a/vm/vm/main/properties.hh b/vm/vm/main/properties.hh
@@ -233,6 +233,8 @@ void PropertyRegistry::gCollect(GC gc) {
 
   gc->copyStableRef(config.defaultExceptionHandler,
                     config.defaultExceptionHandler);
+  gc->copyStableRef(config.errorPrefix,
+                    config.errorPrefix);
 }
 
 }