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»: «{}»»,
;;}»»»
;;» |#
|