[Ecls-list] Small C/C++ Code Snippet For Output Redirection

[Nikhilesh S]

Just got output redirection working. There are a few gray stream
functions left though (like write-sequence). Anyway, here it is:-

...
...

//A demo print function.
cl_object printFunc(cl_object str)
{
     cout << "C/C++ printer says: " << str->base_string.self << endl;
}

int main(int argc, char **argv)
{
     cl_boot(argc, argv);

     //The redirection code.
     cl_safe_eval(c_string_to_object("(defvar *print-function* nil)"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defclass accumulate-stream (gray:fundamental-output-stream) ((lbuffer :accessor buffer-of :initform \"\") (dirty   :accessor is-dirty :initform nil)))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod stream-flush-buffer ((stream accumulate-stream)) (if (and (is-dirty stream) *print-function*) (funcall *print-function* (buffer-of stream))) (gray:stream-clear-output stream))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-force-output ((stream accumulate-stream)) (declare (ignore stream)) (stream-flush-buffer stream) nil)"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-line-column ((stream accumulate-stream)) nil)"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-finish-output ((stream accumulate-stream)) (not (is-dirty stream)))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-clear-output ((stream accumulate-stream)) (setf (buffer-of stream) \"\" (is-dirty stream) nil))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-write-string ((stream accumulate-stream) str &optional start end) (setf (is-dirty stream) t) (setf (buffer-of stream) (concatenate 'string (buffer-of stream) str)))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-write-char ((stream accumulate-stream) char) (setf (is-dirty stream) t) (if (char= char #\\Newline) (stream-flush-buffer stream) (setf (buffer-of stream) (concatenate 'string (buffer-of stream) (coerce (make-array 1 :initial-element char) 'string)))))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(defmethod gray:stream-fresh-line ((stream accumulate-stream)) (stream-flush-buffer stream))"), Cnil, OBJNULL);
     cl_safe_eval(c_string_to_object("(setq *standard-output* (make-instance 'accumulate-stream))"), Cnil, OBJNULL);

     //Bind your print function, and set '*print-function*' to it.
     cl_def_c_function((cl_object) c_string_to_object("test-print"), (cl_object) printFunc, 1);
     cl_safe_eval(c_string_to_object("(setf *print-function* #'test-print)"), Cnil, OBJNULL);

...
...

I'm pretty bad at Lisp, so the Lisp part of it might suck. ;-)

--
Nikhilesh S
http://nikki.drupalsite.org