(in-package :tsdb) (run-process (format nil "~a -p 8765 -L 20 --dump-dir '~a/amk'" (logon-file "mu" "treeblazing.py" :string) (excl::user-homedir)) :wait nil) (defun update-match-p (frame) (and (lkb::compare-frame-in frame) (lkb::compare-frame-out frame))) (defun genia-blazing-hook (frame &key (port 8765) (host "localhost")) (let* ((id (lkb::compare-frame-item frame)) (input (lkb::compare-frame-input frame)) (input (format nil "~a~%" input)) (discriminants (loop for discriminant in (lkb::compare-frame-discriminants frame) for start = (lkb::discriminant-start discriminant) for end = (lkb::discriminant-end discriminant) for edge = (lkb::discriminant-top discriminant) for derivation = (and edge (lkb::edge-bar edge)) for from = (and derivation (derivation-from derivation start)) for to = (and derivation (derivation-to derivation end)) for i from 0 collect (format nil "~a~%" i (xml-escape-string (lkb::discriminant-type discriminant)) start end from to (xml-escape-string (lkb::discriminant-key discriminant)) (xml-escape-string (lkb::discriminant-value discriminant))))) (call (net.xml-rpc:encode-xml-rpc-call "treeblaze" id 0 input discriminants)) (url (format nil "http://~a:~a/" host port))) (handler-case (let ((result (net.xml-rpc:xml-rpc-call call :url url))) (pprint result) (loop for state in result collect (if (stringp state) (let ((c (schar state 0))) (case c (#\+ t) (#\- nil) (t :unknown))) :unknown))) (condition (condition) (format *error-output* "genia-blazing-hook(): error `~a'.~%" (normalize-string (format nil "~a" condition))))))) (setf lkb::*tree-initialization-hook* '("tsdb::genia-blazing-hook" :port 8765))