(define (empty-dir dir)
  (dolist (file (directory dir))
    (if (and
          (!= file ".")
          (!= file "..")
          (directory? (append dir "/" file)))
      (begin
        (empty-dir (append dir "/" file))
        (remove-dir (append dir "/" file)))
      (if (and
            (!= file ".")
            (!= file ".."))
        (begin
          (delete-file (append dir "/" file)))))))


(setq abook-file "C:/KM/address-book.lsp")
(setq vcard-dir "C:/KM/vcards")

(load abook-file)

(if (file? vcard-dir)
  (delete-file vcard-dir))
(if (directory? vcard-dir)
  (empty-dir vcard-dir)
  (make-dir vcard-dir 0750))

(dolist (contact
          (filter (fn (x) (find "Phonebook" (lookup 'groups x)))
                  address-book))
  (unless (empty? (flat (list (lookup 'cell-phone contact)
                              (lookup 'home-phone contact)
                              (lookup 'work-phone contact))))
    (begin
      (device (open (append vcard-dir "/" (lookup 'name contact) ".vcf")
                    "write"))
      (print "BEGIN:VCARD\r\nVERSION:3.0\r\n")
      (print "N;CHARSET=UTF-8:" (lookup 'last-name contact) ";"
             (lookup 'first-name contact) ";;;\r\n")
      ;    (dolist (email-address (lookup 'email-address contact))
      ;      (print "EMAIL;TYPE=INTERNET:" email-address "\r\n"))
      (dolist (phone-number (lookup 'orig-cell-phone contact))
        (replace "[^0-9+]" phone-number "" 1)
        (print "TEL;CELL:" phone-number "\r\n"))
      (dolist (phone-number (lookup 'orig-home-phone contact))
        (replace "[^0-9+]" phone-number "" 1)
        (print "TEL;HOME:" phone-number "\r\n"))
      (dolist (phone-number (lookup 'orig-work-phone contact))
        (replace "[^0-9+]" phone-number "" 1)
        (print "TEL;WORK:" phone-number "\r\n"))
      (print "END:VCARD\r\n")
      (close (device)))))

(exit)

; vim: set tw=76 ts=2 encoding=utf8 fileencoding=utf8 et: