Formatted Output/format <function> Code

(defun format (dest str lst / *error* DimZin format-convert format-calc current)
  (defun *error* (msg /)
    (if DimZin
      (setvar 'DimZin DimZin)
    )
    (or (not msg) (wcmatch (strcase msg) "*ESC*,*QUIT*,*EXIT*") (princ (strcat "**Error: " msg)))
  )
  (setq DimZin (getvar 'DimZin))
  (setvar 'DimZin 0)
  (defun format-convert (code val / s n d)
    (cond ((wcmatch code "*[sS]") val)
          ((wcmatch code "*$") (format-convert "2,D" val))
          ((wcmatch code "*[dDeE]")
           (cond ((wcmatch code "*`,*")
                  (setq d (if (wcmatch code "`,*")
                            nil
                            (atoi code)
                          )
                  )
                  (while (wcmatch code "*`,*") (setq code (substr code 2)))
                  (setq n (atoi code))
                  (setq s (if (wcmatch code "*[dD]")
                            (rtos (float (abs val)) 2 d)
                            (rtof (float (abs val)) d n)
                          )
                  )
                  (repeat (- n (strlen (itoa (atoi s)))) (setq s (strcat "0" s)))
                  (if (< val 0.0)
                    (strcat "-" s)
                    s
                  )
                 )
                 ((wcmatch code "#*") (rtos (float val) 2 (atoi code)))
                 ((= (type val) 'REAL) (rtos val))
                 (t (itoa val))
           )
          )
    )
  )
  (defun format-calc (str lst / s)
    (cond (current
           (cond ((wcmatch current "*[DdEeSs$]")
                  (setq s       (format-convert current (car lst))
                        current nil
                  )
                  (strcat s
                          (format-calc
                            str
                            (if (cdr lst)
                              (cdr lst)
                              lst
                            )
                          )
                  )
                 )
                 (t (setq current (strcat current (substr str 1 1))) (format-calc (substr str 2) lst))
           )
          )
          ((wcmatch str "`~*") (setq current "") (format-calc (substr str 2) lst))
          ((eq str "") "")
          (t (strcat (substr str 1 1) (format-calc (substr str 2) lst)))
    )
  )
  (if (atom lst)
    (setq lst (cons lst nil))
  )
  (setq current (cond ((= dest t) (princ (format-calc str lst)))
                      ((= (type dest) 'FILE) (princ (format-calc str lst) dest))
                      ((and (= (type dest) 'SYM) (= (type (eval dest)) 'STR))
                       (setq dest (strcat (eval dest (format-calc str lst))))
                      )
                      (t (format-calc str lst))
                )
  )
  (*error* nil)
  current
)