[climacs-cvs] CVS climacs

[crhodes]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv7575

Modified Files:
	climacs.asd prolog-syntax.lisp prolog2paiprolog.lisp 
Log Message:
Restore prolog2paiprolog

The source isn't clean, but its primary use right now is to check that 
prolog syntax is vaguely working (since we don't have prolog syntax 
highlighting).


--- /project/climacs/cvsroot/climacs/climacs.asd	2008/01/09 12:56:02	1.68
+++ /project/climacs/cvsroot/climacs/climacs.asd	2008/01/10 10:48:24	1.69
@@ -35,7 +35,7 @@
 ;;    (:file "cl-syntax" :depends-on ("packages"))
 ;;    (:file "html-syntax" :depends-on ("packages"))
    (:file "prolog-syntax" :depends-on ("packages"))
-;;    (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
+   (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
 ;;    (:file "ttcn3-syntax" :depends-on ("packages"))
    (:file "climacs-lisp-syntax" :depends-on ("core" "groups"))
    (:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
--- /project/climacs/cvsroot/climacs/prolog-syntax.lisp	2008/01/09 18:23:21	1.33
+++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp	2008/01/10 10:48:24	1.34
@@ -26,13 +26,16 @@
 (defclass prolog-parse-tree (parse-tree)
   ())
 
+(define-syntax-command-table prolog-table :errorp nil)
+
 (define-syntax prolog-syntax (fundamental-syntax)
   ((lexer :reader lexer)
    (valid-parse :initform 1)
    (parser)
    (operator-directives :initform nil :accessor operator-directives))
   (:name "Prolog")
-  (:pathname-types "pl"))
+  (:pathname-types "pl")
+  (:command-table prolog-table))
 
 (defparameter *prolog-grammar* (grammar))
 
--- /project/climacs/cvsroot/climacs/prolog2paiprolog.lisp	2006/11/12 16:06:06	1.3
+++ /project/climacs/cvsroot/climacs/prolog2paiprolog.lisp	2008/01/10 10:48:24	1.4
@@ -20,6 +20,8 @@
 
 (in-package #:climacs-prolog-syntax)
 
+#+nil
+(progn
 (defclass prolog-buffer (standard-buffer) 
   ((filepath :initform nil :accessor filepath)
    (syntax :accessor syntax)))
@@ -28,9 +30,12 @@
   (declare (ignore args))
   (with-slots (syntax) buffer
     (setf syntax (make-instance 'prolog-syntax :buffer buffer))))
+)
 
 (defvar *loaded-files* nil "List of files loaded by ensure_loaded directive.")
 
+#+nil
+(progn
 (defun eval-prolog-file (filepath) 
   (setf *loaded-files* nil)
   (let ((*package* 
@@ -51,10 +56,12 @@
     (update-syntax-for-display buffer (syntax buffer) (low-mark buffer) 
                                (high-mark buffer))
     buffer))
+)
 
-(defun buffer->paiprolog (buffer) 
-  (let ((lexemes (drei-syntax::lexemes (lexer (syntax buffer))))
+(defun view->paiprolog (view)
+  (let ((lexemes (drei-syntax::lexemes (lexer (syntax view))))
         (expressions '()))
+    (update-parse (syntax view))
     (dotimes (i (flexichain:nb-elements lexemes) (nreverse expressions))
       (let ((lexeme (flexichain:element* lexemes i)))
         (when (typep lexeme 'end-lexeme)
@@ -76,12 +83,12 @@
                           (ensure-loaded 
                            (unless (member (cadr dexpr) *loaded-files* 
                                            :test #'string=)
-                             (dolist (e (buffer->paiprolog 
+                             (dolist (e (view->paiprolog 
                                          (find-prolog-file (cadr dexpr))))
                                (push e expressions))
                              (push (cadr dexpr) *loaded-files*)))
                           (include 
-                           (dolist (e (buffer->paiprolog 
+                           (dolist (e (view->paiprolog 
                                        (find-prolog-file (cadr dexpr))))
                              (push e expressions)))))
                       (return))
@@ -403,3 +410,10 @@
 
 (defun intern-paiprolog (name)
   (intern (string-upcase name) :paiprolog))
+
+(define-command (com-export-paiprolog :name t :command-table prolog-table) 
+    ((pathname 'pathname))
+  (let ((expressions (view->paiprolog (current-view))))
+    (with-open-file (s pathname :direction :output :if-exists :supersede)
+      (dolist (e expressions)
+	(prin1 e s)))))