(defun lh (name &rest children)
  (cons 'header (cons name children)))

(defun folderp (c)
  (and (consp c)
       (eq 'header (car c))
       (symbolp (cadr c))))

(defun folder-name (c)
  (when (folderp c)
    (cadr c)))

(defun folder-names (cn)
  (loop for c in  (children cn)
        when (folderp c) collect (folder-name c)))

(defun folders (cn)
  (loop for c in  (children cn)
        when (folderp c) collect (identity c)))

(defun folders-find (cn name)
  (loop for c in  (children cn)
        when (and (folderp c)
                  (eq (folder-name c) name))
          collect (identity c)))

(defun folders-find-first (cn name)
  (loop for c in  (children cn)
        when (and (folderp c)
                  (eq (folder-name c)
                      name))
          return (identity c)))

(defun folders-path (cn names-path)
  (if (endp names-path)
      cn
      (let ((found (folders-find-first cn (car names-path))))
        (when found
          (folders-path found (cdr names-path))))))

(defun folders-make (names-path)
  (if names-path
      (lh (first names-path) (folders-make (rest names-path)))))

(defun folders-ensure (cn names-path)
  (let ((found (folders-find-first cn (car names-path))))
    (if found
        ;; then
        (folders-ensure found (cdr names-path))
        ;; else setting the tree still does not work
        (setf (cdr cn)
              (append (cdr cn)
                      (list (folders-make names-path)))))))

(defun children (c)
  (cddr c))

(defparameter *tree* (lh 'root
                         1 2
                         (lh 'three
                             3 33 333
                             (lh 'q34
                                 34
                                 (lh 'q344 :a :b :c)
                                 3444)
                             3333 33333)
                         4
                         (lh 'five
                             5 55 555)
                         6))