#!/home/keithp/bin/kalypso

(defun indent-level (s)
  (cond ((nil? s) 0)
	((= (scar s) ~\t) (1+ (indent-level (scdr s))))
	(t 0)
	)
  )

(defun is-white? (c)
  (or (= c ~ ) (= c ~\t))
  )

(defun is-digit? (c)
  (and (<= ~0 c) (<= c ~9))
  )

(defun strip-white (s)
  (cond ((nil? s) nil)
	((is-white? (scar s)) (strip-white (scdr s)))
	(t s)
	)
  )

(defun strip-num (s)
  (cond ((nil? s) nil)
    	((or (is-digit? (scar s)) (= (scar s) ~ ))
	 (strip-num (scdr s))
	 )
	(t s)
	)
  )

(defun get-unindented-line (f)
  (let ((s (sreverse (scdr (sreverse (fgets f))))))
    (strip-white s)
    )
  )

(defun read-unindented-line (f)
  (strip-white (read-line f))
  )

(defun read-line (f)
  (let ((s (fgets f))
	(rs)
	)
    (cond ((nil? s) nil)
	  (t
	   (setq rs (scdr (sreverse s)))
    	   (cond ((nil? rs) (read-line f))
	  	 ((= (scar rs) ~\\)
	   	  (strcat (sreverse (scdr rs)) " " (read-unindented-line f))
	   	  )
	  	 ((= (scar rs) ~!)
	   	  (strcat (sreverse (scdr rs)) "\n" (read-unindented-line f))
	   	  )
	  	 (t
	   	  (sreverse rs)
	   	  )
	  	 )
	   )
    	  )
    )
  )

(defun get-line (f)
  (let ((s (strip-num (read-line f))) (rs))
    (cond ((nil? s) nil)
	  ((nil? (scdr s)) (get-line f))
	  (t
    	   (list (indent-level s) (strip-white s))
    	   )
	  )
    )
  )

(defun get-lines-helper (f l)
  (cond ((nil? l) nil)
	(t (cons l (get-lines-helper f (get-line f))))
	)
  )

(defun get-lines (f)
  (get-lines-helper f (get-line f))
  )

(defun get-slide (lines level)
  (cond ((nil? lines) nil)
   	((< (caar lines) level) nil)
	((= (caar lines) level)
	 (cons (cadar lines) (get-slide (cdr lines) level))
	 )
	(t
	 (get-slide (cdr lines) level)
	 )
	)
  )

(defun find-deeper (lines level)
  (cond ((nil? lines) nil)
	((> (caar lines) level) lines)
	((= (caar lines) level) nil)
	(t nil)
	)
  )
	 
(defun find-same (lines level)
  (cond ((nil? lines) nil)
	((> (caar lines) level) (find-same (cdr lines) level))
	((= (caar lines) level) lines)
	(t nil)
	)
  )

(defun find-slides (lines level topic)
  (let ((parent (cons topic (get-slide lines level)))
	(next-level)
	(sibling lines)
	(rest)
	)
    (while sibling
      (cond ((setq next-level (find-deeper (cdr sibling) level))
	     (setq rest (conc rest
			      (find-slides next-level
					   (caar next-level)
					   (cadar sibling)
					   )
			      )
		   )
	     )
	    )
      (setq sibling (find-same (cdr sibling) level))
      )
    (cons parent rest)
    )
  )

(defun print-file (f)
  (let ((lines (get-lines f)))
    (cond ((nil? lines) nil)
	  (t (format-slides (cdr (find-slides lines (caar lines) ""))))
	  )
    )
  )

(defun print-file-name (name)
  (let ((f (fopen name "r")) (lines))
    (unwind-protect
      (print-file f)
      (fclose f)
      )
    )
  )

(defun format-slide-entry (entry)
  (cond ((= (scar entry) ~.)
	 (format "%a\n" entry)
	 )
	(t
  	 (format ".Eb\n%a\n.Ee\n" entry)
	 )
	)
  )

(defun format-slide-entries (slide)
  (cond ((nil? slide) nil)
	(t
	 (format-slide-entry (car slide))
	 (format-slide-entries (cdr slide))
	 )
	)
  )

(defun format-slide (slide)
  (format ".Sb\n%a\n" (car slide))
  (format-slide-entries (cdr slide))
  (format ".Se\n")
  )

(defun format-slides (slides)
  (cond ((nil? slides) nil)
	(t
	 (format-slide (car slides))
	 (format-slides (cdr slides))
	 )
	)
  )

(defun lisp-main (argc  argv)
  (setq argv (cdr argv))
  (setq header "Sh")
  (cond ((= (car argv) "-header")
	 (setq header (cadr argv))
	 (setq argv (cddr argv))
	 )
	)
  (format ".%a\n" header)
  (cond (argv
	 (while argv
	   (print-file-name (car argv))
	   (setq argv (cdr argv))
	   )
	 )
	(t
	 (print-file stdin)
	 )
	)
  )

(lisp-main argc argv)
	
