[Ecls-list] new ECL list member/ ECL project

[Goffioul Michael]

> Hi Michael,
> 
> Thanks for that. My app doesn't crash now.
> How do you setup a gray stream ?
> 
> I'd love to be able to echo errors and general standard 
> output goodness to the screen.
> 
> In the FAQ, it points to xchat, but I couldn't find the 
> implementation of gray streams there.

Here are parts of my implementation (not fully functional, but you
probably get the idea). lisp.d defines the MEX interface and the
low-level
routines to redirect ECL outputs to MATLAB window. It also defines a
temporary output stream as a string-stream used during the
initialization
process. Finally, it loads minit.lsp (compiled in the MEX file, loaded
through the init_MINIT call), which setup the gray streams.

======
lisp.d
======

static cl_object out_stream = Cnil;

static
@(defun "matlab_invoke_debugger" (condition old_debugger_hook)
@
        /* Flush any initialization message */
        if ( !Null( out_stream ) )
                mexPrintf( "%s", cl_get_output_stream_string( out_stream
)->string.self );

        cl_object err_str = cl_format( 4, Cnil, make_constant_string(
"LISP error => ~A~C" ), condition, CODE_CHAR('\0') );
        mexErrMsgIdAndTxt( "LISP:error", (char*)err_str->string.self );
        @( return Cnil )
@)

static
@(defun "matlab_quit" ()
@
        mexWarnMsgIdAndTxt("LISP:quit", "QUIT function is disabled in
LISP, use the 'quit' function from MATLAB instead.");
        @(return Cnil)
@)

#define MEX_BUFFER_LEN 128
static char mex_buffer[ MEX_BUFFER_LEN ];
static int mex_buffer_index = 0;

static cl_object matlab_mex_flush()
{
        mex_buffer[ mex_buffer_index ] = '\0';
        mexPrintf( "%s", mex_buffer );
        mex_buffer_index = 0;
        @( return Cnil );
}

static cl_object matlab_mex_write_char( cl_object c )
{
        assert_type_character( c );
        mex_buffer[ mex_buffer_index++ ] = CHAR_CODE( c );
        if ( mex_buffer_index == ( MEX_BUFFER_LEN-1 ) || CHAR_CODE(c) ==
'\n')
        {
                /* time to flush buffer */
                matlab_mex_flush();
        }
        @( return c )
}

void lisp_matlab_init()
{
        /* Install temporary I/O streams to catch messages during
initialization */
        out_stream = cl_make_string_output_stream( 0 );
        ECL_SET( @'*terminal-io*', cl_make_two_way_stream(
cl_make_string_input_stream( 1, make_constant_string( "" ) ),
                                                        out_stream ) );
        ECL_SET( @'*error-output*', out_stream );

        /* Catch errors through invoke-debugger; redefine "quit" */
        cl_object mdbg_sym = c_string_to_object("MATLAB-DEBUGGER-HOOK");
        cl_def_c_function_va(mdbg_sym, (void*)matlab_invoke_debugger);
        ECL_SET( @'*debugger-hook*', mdbg_sym);
        cl_def_c_function_va(@'ext::quit', ( void* )matlab_quit);

        /* Create "MATLAB" package */
        cl_object mpack = make_package( make_constant_string( "MATLAB"
), Cnil, cl_list( 1, make_constant_string( "COMMON-LISP" ) ) );
        cl_def_c_function( _intern( "MEX-WRITE-CHAR", mpack ), ( void*
)matlab_mex_write_char, 1 );
        cl_def_c_function( _intern( "MEX-FLUSH", mpack ), ( void*
)matlab_mex_flush, 0 );

        /* Load initialization file */
        cl_object user_pack =
cl_find_package(c_string_to_object("CL-USER"));
        read_VV(OBJNULL, init_MINIT);
        si_select_package(user_pack);

        /* Undefine temporary output stream, as it should have been
redefined in "minit.lsp" */
        out_stream = Cnil;
}

=========
minit.lsp
=========

(defclass matlab-stream (ext::fundamental-character-output-stream)
(last-char))

(defun matlab-debug (fmt &rest args)
  (with-open-file (f "debug.txt" :direction :output :if-exists :append
:if-does-not-exist :create)
    (apply #'format (append (list f fmt) args))))

(defmethod ext::stream-write-char ((stream matlab-stream) c)
  ;(matlab-debug "Writing char: [~A] ~A~%" (char-code c) c)
  (matlab::mex-write-char c))

(defmethod ext::stream-force-output ((stream matlab-stream))
  ;(matlab-debug "stream-force-output called~%")
  (matlab::mex-flush)
  t)

(let ((old-io *terminal-io*))
  (setq *terminal-io* (make-two-way-stream (make-string-input-stream "")
(make-instance 'matlab-stream)))
  (setq *error-output* (two-way-stream-output-stream *terminal-io*))
  ; Flush any pending message
  (and (typep old-io 'two-way-stream) (typep
(two-way-stream-output-stream old-io) 'string-stream)
       (format t "~A" (get-output-stream-string
(two-way-stream-output-stream old-io)))))