mailto.lisp

(defpackage mailto
  (:use :cl)
  (:export :make-machine :parse :host :userinfo :valid))
(in-package mailto)
(defclass machine ()
  ((host :initform nil :accessor host)
   (userinfo :initform nil :accessor userinfo)
   (leftover :initarg :leftover :reader leftover)
   (valid :initform nil :accessor valid)))
(defun make-machine (chars) (make-instance 'machine :leftover chars))
(defun parse-host (host-machine user-machine)
  (setf (host:leftover host-machine) (userinfo:leftover user-machine))
  (host:parse host-machine))
(defmethod validate ((m machine) host-machine user-machine)
  (setf (valid m)
        (and (host:valid host-machine)
             (userinfo:valid user-machine)
             (not (host:leftover host-machine)))))
(defmethod setv ((m machine) &key host userinfo)
  (setf (values (host m) (userinfo m)) (values host userinfo)))
(defmethod parse ((m machine))
  (let ((user-machine (userinfo:make-machine (leftover m)))
        (host-machine (host:make-machine nil)))
    (userinfo:parse user-machine)
    (if (string= (userinfo:state user-machine) "at")
        (parse-host host-machine user-machine))
    (validate m host-machine user-machine)
    (if (valid m)
        (setv m
              :host (host:value host-machine)
              :userinfo (userinfo:value user-machine)))))