A.message

hellow

a.message

hello

losplines.lisp

(defvar prev nil)
(defvar prevno nil)
(defvar line-spaces nil)
(defvar prev-spaces nil)
(defvar line nil)
(defvar lineno 0)
(defvar arr (list 0))
(defvar inpf *standard-input*)
(defvar outf *standard-output*)
(defvar errf *error-output*)
(defun repeat-char (c n)
(  concatenate 'string
(               make-array n :initial-element (elt c 0))))
(defun spaces (line spaces)
(  setf line-spaces
(        if ({ spaces eq (length line)) nil
(             if ({ (elt line spaces) eq (elt " " 0))
(                  spaces line (incf spaces))
(                  values spaces)))))
(defun shift ()
(  setf prev-spaces line-spaces)
(  setf prevno lineno)
(  setf prev line))
(defmacro { (b a &rest r) `(,a ,b ,@r))
(defun de-dent (n)
(  if ({ (car arr) > line-spaces)
(      progn
(        pop arr)
(        de-dent (incf n)))
(      values n)))
(defun process-line (line-spaces line)
(  let
(    vars
(      prefix "(")
(      suffix "")
(      endstr ""))
(    when prevno
(      if ({ prev-spaces < line-spaces)
(          push line-spaces arr)
(          setf suffix ")"))
(      if ({ prev-spaces > line-spaces)
(          setf endstr (repeat-char ")" (de-dent 0))))
(      if
(       search
(        string (elt prev prev-spaces))
(        values "0123456789\"'`:"))
(       setf prefix " "))
(      format outf "~a~a~a~a~%" prefix prev suffix endstr))))
(defun proc-loop (lineno line)
(  if line
(      when (spaces line 0)
(        process-line line-spaces line)
(        shift)
(        proc-loop (incf lineno) (read-line inpf nil nil)))
(      process-line 0 ";;<<eof>>")))
(defun parse-file (inp out)
(  with-open-file
(     inpf inp)
(     with-open-file
(       outf out :direction :output :if-exists :supersede)
(       proc-loop (incf lineno) (read-line inpf nil nil)))))
(if (member :clisp *features*)
(  defvar **args** *args*))
(if (member :sbcl  *features*)
(  defvar **args** (cdr *posix-argv*)))
(defun main (&rest rest)
(  apply #'parse-file rest)
(  values nil))
(apply #'main **args**)

losplines.losp

defvar prev nil
defvar prevno nil
defvar line-spaces nil
defvar prev-spaces nil
defvar line nil
defvar lineno 0
defvar arr (list 0)
defvar inpf *standard-input*
defvar outf *standard-output*
defvar errf *error-output*
defun repeat-char (c n)
  concatenate 'string
               make-array n :initial-element (elt c 0)
defun spaces (line spaces)
  setf line-spaces
        if ({ spaces eq (length line)) nil
             if ({ (elt line spaces) eq (elt " " 0))
                  spaces line (incf spaces)
                  values spaces
defun shift ()
  setf prev-spaces line-spaces
  setf prevno lineno
  setf prev line
defmacro { (b a &rest r) `(,a ,b ,@r)
defun de-dent (n)
  if ({ (car arr) > line-spaces)
      progn
        pop arr
        de-dent (incf n)
      values n
defun process-line (line-spaces line)
  let
    vars
      prefix "("
      suffix ""
      endstr ""
    when prevno
      if ({ prev-spaces < line-spaces)
          push line-spaces arr
          setf suffix ")"
      if ({ prev-spaces > line-spaces)
          setf endstr (repeat-char ")" (de-dent 0))
      if
       search
        string (elt prev prev-spaces)
        values "0123456789\"'`:"
       setf prefix " "
      format outf "~a~a~a~a~%" prefix prev suffix endstr
defun proc-loop (lineno line)
  if line
      when (spaces line 0)
        process-line line-spaces line
        shift
        proc-loop (incf lineno) (read-line inpf nil nil)
      process-line 0 ";;<<eof>>"
defun parse-file (inp out)
  with-open-file
     inpf inp
     with-open-file
       outf out :direction :output :if-exists :supersede
       proc-loop (incf lineno) (read-line inpf nil nil)
if (member :clisp *features*)
  defvar **args** *args*
if (member :sbcl  *features*)
  defvar **args** (cdr *posix-argv*)
defun main (&rest rest)
  apply #'parse-file rest
  values nil
apply #'main **args**

Makefile

all: regen
regen: clean ln.lsp ; diff ln.lsp ln.lisp
%.lsp: %.losp ; clisp ln.lisp $< $@
clean: ; rm -fr ? *.lsp *~