git.fiddlerwoaroof.com
cluffer-sample.lisp
a8c901ce
 (defpackage :fwoar.lisp-sandbox.cluffer-sample
   (:use :cl )
   (:export ))
 (in-package :fwoar.lisp-sandbox.cluffer-sample)
 
 #| from:
 ;;   https://github.com/robert-strandh/Second-Climacs/ |#
 (defun make-empty-standard-buffer-and-cursor ()
   (let* ((line (make-instance 'cluffer-standard-line:closed-line))
          (buffer (make-instance 'cluffer-standard-buffer:buffer
                                 :initial-line line))
          (cursor (make-instance 'cluffer-standard-line:right-sticky-cursor)))
     (cluffer:attach-cursor cursor line)
     (values buffer cursor)))
 
 (defun fill-buffer-from-stream (cursor stream)
   (loop for char = (read-char stream nil nil)
         until (null char)
         do (cluffer:insert-item cursor char)
         when (eql char #\newline)
           do (cluffer:split-line cursor)))
 #| End stolen code |#
 
 (defmacro with-file-buffer ((buffer cursor file) &body body)
   (alexandria:with-gensyms (stream)
     `(multiple-value-bind (,buffer ,cursor) (make-empty-standard-buffer-and-cursor)
        (with-open-file (,stream ,file)
          (fill-buffer-from-stream ,cursor ,stream))
        ,@body)))
 (defmacro with-stream-buffer ((buffer cursor stream) &body body)
   (alexandria:with-gensyms (s)
     `(multiple-value-bind (,buffer ,cursor) (make-empty-standard-buffer-and-cursor)
        (with-open-stream (,s ,stream)
          (fill-buffer-from-stream ,cursor ,stream))
        ,@body)))
 
 (defun buffer-lines (buffer)
   (loop with cursor = (make-instance 'cluffer-standard-line:right-sticky-cursor)
         for x below (cluffer:line-count buffer)
         for line = (cluffer:find-line buffer x)
         do (cluffer:attach-cursor cursor line)
         collect (coerce (cluffer:items cursor) 'string)
         do (cluffer:detach-cursor cursor)))
 
 (defun buffer-to-string (buffer)
   (serapeum:string-join
    (loop with cursor = (make-instance 'cluffer-standard-line:right-sticky-cursor)
          for x below (cluffer:line-count buffer)
          for line = (cluffer:find-line buffer x)
          do (cluffer:attach-cursor cursor line)
          collect (coerce (cluffer:items cursor) 'string)
          do (cluffer:detach-cursor cursor))
    ""))
 
 (defun get-all-cursors (tree buffer)
   (labels ((int (tree sc ec)
              (destructuring-bind (_ __ pos children)
                  (fwoar.lisp-sandbox.tree-sitter-parser::parse-thing tree)
                (declare (ignore _ __))
                (destructuring-bind
                    ((start-c start-l) (end-c end-l)) pos
                  (let ((cursor1 (make-instance
                                  'cluffer-standard-line:right-sticky-cursor))
                        (cursor2 (make-instance
                                  'cluffer-standard-line:right-sticky-cursor)))
                    (cluffer:attach-cursor cursor1
                                           (cluffer:find-line buffer start-l)
                                           start-c)
                    (cluffer:attach-cursor cursor2
                                           (cluffer:find-line buffer end-l)
                                           end-c)
                    (funcall sc cursor1)
                    (funcall ec cursor2)
                    (when children
                      (mapcar (lambda (it)
                                (int it sc ec))
                              children)))))))
     (serapeum:with-collectors (sc ec)
       (int tree #'sc #'ec))))
 
 (defun insert-guillemets (tree buffer)
   (multiple-value-bind (starts ends)
       (get-all-cursors tree buffer)
     (mapcar (lambda (start end)
               (cluffer:insert-item start #\«)
               (cluffer:insert-item end #\»))
             starts
             ends)))
 
 (defun main-s (file-contents)
   (with-input-from-string (s file-contents)
     (with-stream-buffer (buffer cursor s)
       (insert-guillemets (cl-tree-sitter:parse-string :tsx file-contents)
                          buffer)
       (buffer-to-string buffer))))
 
 (defun main (file)
   (let ((file-contents (alexandria:read-file-into-string file)))
     (with-file-buffer (buffer cursor file)
       (insert-guillemets (cl-tree-sitter:parse-string :tsx file-contents)
                          buffer)
       (buffer-to-string buffer))))
 
 #|CLUFFER-SAMPLE> (princ (main "~/foo.ts"))
 ;;««interface «Foo» «{
 ;;  ««it»«: «string»»»;
 ;;  ««ot»«: ««Record»«<«string», «never»>»»»»;
 ;;}»»
 ;;
 ;;«const ««Bar»«: «Foo»» = «{
 ;;  ««it»: «'asdfasf'»»,
 ;;  ««ot»: «{}»»,
 ;;}»»»
 ;;» |#