1a481a69 |
(defpackage :ssh-configurator
(:use :clim :clim-lisp))
(in-package :ssh-configurator)
(defclass host ()
((%hosts :initarg :hosts :reader hosts)
(%options :initarg :options :reader options)))
(defclass ssh-config ()
((%hosts :initarg :hosts :reader hosts)
(%options :initarg :options :reader options)))
(defgeneric read-in (file object)
(:method ((path string) object)
(read-in (pathname path) object))
(:method ((path pathname) object)
(alexandria:with-input-from-file (f path)
(read-in f object))))
(defmethod read-in (file (host-blocks))
)
(defun prefix-count-if (pred seq)
(length (serapeum:take-while pred seq)))
(defun read-indented-block (stream)
(values (loop for line = (read-line stream nil)
for next-char = (peek-char nil stream nil)
for whitespace-count = (prefix-count-if #'serapeum:whitespacep line)
when (< whitespace-count (length line)) collect
(cons whitespace-count
(subseq line whitespace-count))
while (and next-char
(serapeum:whitespacep next-char)))
stream))
(defun tokenize-block (block)
(mapcar (alexandria:compose 'serapeum:tokens
'cdr)
block))
(defun read-all-indented-blocks (stream)
(loop for block = (read-indented-block stream)
while block
collect block))
(define-application-frame ssh-configurator ()
((host-blocks :initarg :host-blocks :accessor host-blocks
:initform (error "need host blocks...")))
(:panes
(hosts (make-pane 'list-pane :items (host-blocks *application-frame*)))
(props (make-pane 'list-pane :items '(2 3 41 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18))))
(:layouts
(default (vertically ()
(scrolling ()
hosts)
(scrolling ()
props))))
)
(defun ssh-configurator (host-blocks)
(fw.lu:prog1-bind (f (make-application-frame 'ssh-configurator
:host-blocks host-blocks))
(bt:make-thread
(serapeum:op (run-frame-top-level f))
:name "ssh-configurator")))
(defmacro print-and-return-when ((condition) form &rest others)
`(let ((result ,form))
(when ,condition
(format *trace-output* "~&Result is: ~s~%~4t(~{~s~^ ~})~%" result (list ,@others)))
result))
(defun get-all-subclasses (object)
(print-and-return-when ((typep (car result) 'standard-class))
(etypecase object
(list (mapcar 'get-all-subclasses object))
(null (princ :what?))
(symbol (get-all-subclasses (find-class object)))
((or standard-class sb-mop:funcallable-standard-class)
(list (class-name object)
(get-all-subclasses (sb-mop:class-direct-subclasses object)))))
))
(defpackage :ssh-configurator/t
(:use :cl :should-test))
(in-package :ssh-configurator/t)
(import 'ssh-configurator::read-indented-block)
(deftest read-indented-block ()
()
(should be equal
'((0 . "a b c") (4 . "d"))
(with-input-from-string (s (format nil "a b c~%~4td"))
(read-indented-block s)))
(should be equal
'((0 . "e f g") (4 . "h"))
(with-input-from-string (s (format nil "a b c~%~4td~%e f g~%~4th"))
(read-indented-block
(nth-value 1 (read-indented-block s)))))
(should be equal
'((0 . "e f g") (4 . "h"))
(with-input-from-string (s (format nil "a b c~%~4td~%e f g~%~4th~% "))
(read-indented-block
(nth-value 1 (read-indented-block s)))))
(should be equal
nil
(with-input-from-string (s (format nil ""))
(read-indented-block
(nth-value 1 (read-indented-block s)))))
(should be equal
nil
(with-input-from-string (s (format nil " "))
(read-indented-block
(nth-value 1 (read-indented-block s))))))
|