Create a Common Lisp macro for the following transformation. Before code:
(with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) `(let ((,parent-type (or (find-coloring-type ,parent) (and ,parent (error "No such coloring type: ~S" ,parent))))) (setf (find-coloring-type ,name) (make-instance 'coloring-type :fancy-name ',fancy-name :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) :default-mode (or ',default-mode (if ,parent-type (coloring-type-default-mode ,parent-type))) ,@(if autodetect `(:autodetect-function ,autodetect)) :parent-type ,parent-type :visible (not ,invisible) :formatter-initial-values (lambda nil (list* ,@(mapcar #'(lambda (e) `(cons ',(car e) ,(second e))) formatter-variables) (if ,parent-type (funcall (coloring-type-formatter-initial-values ,parent-type)) nil))) :formatter-after-hook (lambda nil (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (concatenate 'string (funcall ,formatter-after-hook) (if ,parent-type (funcall (coloring-type-formatter-after-hook ,parent-type)) "")))) :term-formatter (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (lambda (,term) (labels ((call-parent-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (if ,parent-type (funcall (coloring-type-term-formatter ,parent-type) (cons ,type ,string)))) (call-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (funcall (case (first ,type) ,@formatters (t (lambda (,type text) (call-parent-formatter ,type text)))) ,type ,string))) (call-formatter)))) :transition-functions (list ,@(loop for transition in transitions collect (destructuring-bind (mode &rest table) transition `(cons ',mode (lambda (,current-mode ,string ,position) (let ((,mode-wait (constantly nil)) (,position-foobage ,position)) (with-scanning-functions ,string ,position-foobage ,current-mode ,mode-wait (let ((*reset-position* ,position)) (cond ,@table)) (values ,position-foobage ,current-mode (lambda (,new-position) (setf ,position-foobage ,new-position) (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) (values ,position-foobage ,advance))))) ))))))))))

What needs to change: Macro call that should be transformed by with-gensyms

Macro definition:
(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(mapcar #'(lambda (name)
                     (list name `(make-symbol ,(symbol-name name)))) names)
    ,@body))

Macroexpansion:
(let ((parent-type (gensym #A((11) base-char . "PARENT-TYPE"))) (term (gensym #A((4) base-char . "TERM"))) (type (gensym #A((4) base-char . "TYPE"))) (string (gensym #A((6) base-char . "STRING"))) (current-mode (gensym #A((12) base-char . "CURRENT-MODE"))) (position (gensym #A((8) base-char . "POSITION"))) (position-foobage (gensym #A((16) base-char . "POSITION-FOOBAGE"))) (mode-wait (gensym #A((9) base-char . "MODE-WAIT"))) (new-position (gensym #A((12) base-char . "NEW-POSITION"))) (advance (gensym #A((7) base-char . "ADVANCE")))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr parent-type :kind 0) (or (find-coloring-type #S(sb-impl::comma :expr parent :kind 0)) (and #S(sb-impl::comma :expr parent :kind 0) (error "No such coloring type: ~S" #S(sb-impl::comma :expr parent :kind 0)))))) (setf (find-coloring-type #S(sb-impl::comma :expr name :kind 0)) (make-instance (quote coloring-type) :fancy-name (quote #S(sb-impl::comma :expr fancy-name :kind 0)) :modes (append (quote #S(sb-impl::comma :expr modes :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-modes #S(sb-impl::comma :expr parent-type :kind 0)))) :default-mode (or (quote #S(sb-impl::comma :expr default-mode :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-default-mode #S(sb-impl::comma :expr parent-type :kind 0)))) #S(sb-impl::comma :expr (if autodetect (sb-int:quasiquote (:autodetect-function #S(sb-impl::comma :expr autodetect :kind 0)))) :kind 2) :parent-type #S(sb-impl::comma :expr parent-type :kind 0) :visible (not #S(sb-impl::comma :expr invisible :kind 0)) :formatter-initial-values (lambda nil (list* #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr (car e) :kind 0)) #S(sb-impl::comma :expr (second e) :kind 0))))) formatter-variables) :kind 2) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-initial-values #S(sb-impl::comma :expr parent-type :kind 0))) nil))) :formatter-after-hook (lambda nil (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (concatenate (quote string) (funcall #S(sb-impl::comma :expr formatter-after-hook :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-after-hook #S(sb-impl::comma :expr parent-type :kind 0))) "")))) :term-formatter (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (lambda (#S(sb-impl::comma :expr term :kind 0)) (labels ((call-parent-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-term-formatter #S(sb-impl::comma :expr parent-type :kind 0)) (cons #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0))))) (call-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (funcall (case (first #S(sb-impl::comma :expr type :kind 0)) #S(sb-impl::comma :expr formatters :kind 2) (t (lambda (#S(sb-impl::comma :expr type :kind 0) text) (call-parent-formatter #S(sb-impl::comma :expr type :kind 0) text)))) #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0)))) (call-formatter)))) :transition-functions (list #S(sb-impl::comma :expr (loop for transition in transitions collect (destructuring-bind (mode &rest table) transition (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr mode :kind 0)) (lambda (#S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position :kind 0)) (let ((#S(sb-impl::comma :expr mode-wait :kind 0) (constantly nil)) (#S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr position :kind 0))) (with-scanning-functions #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr mode-wait :kind 0) (let ((*reset-position* #S(sb-impl::comma :expr position :kind 0))) (cond #S(sb-impl::comma :expr table :kind 2))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) (lambda (#S(sb-impl::comma :expr new-position :kind 0)) (setf #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr new-position :kind 0)) (let ((#S(sb-impl::comma :expr advance :kind 0) (nth-value 1 (funcall #S(sb-impl::comma :expr mode-wait :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0))))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr advance :kind 0)))))))))))) :kind 2)))))))