(use goo)
(use goo/system)
(use goo/boot)

(use util/net/mail/cclientx.swig)

;; Technique for dealing with the native binding:
;;  So, unlike GTK, there is no need to have a native representation underlying everything.  C-client
;;   is just a communications channel abstraction for us, not a data model.  So I'm going to be
;;   imitating the Perl bindings for c-client to some extent.  (In that we will shuffle everything
;;   into our own representation, which I suppose isn't really that imitatingy.)  It should be noted
;;   that this technique *will* have some side-effects.  Namely, message renumbering will probably
;;   bite us if we don't pay close attention.  To make things simpler in that regard we can use the
;;   unique-id's to refer to messages.  The one potential problem is that the IMAP4 spec allows 
;;   servers to be rampantly inconsistent about their UID's, although I think they might have to
;;   be consistent per-session at least, which is all we really need.  So by using uid's we can punt
;;   on msgno/seq num's, but if we want to support that as well we'll probably be regretting that
;;   we're not just holding onto eltcache elements underneath, as I think we get special reporting
;;   on them, or they get auto-renumbered, or something.  Alright, to be honest, I probably don't
;;   have any idea about that, but I say let's use uid's for now and screw people who don't have them.

;; ISSUE! Should SWIG be returning "" for NULL strings?  Probably!

(dv NULL (%lb 0))
(dv null_loc NULL)

;; Base Class for c-client stuff that has a handle
(dc <cclient-native> (<any>))
 (dp cc-handle (<cclient-native> => <loc>)) ;; stupid namespace something or other, retza freckin...

(dc <cclient-stream> (<cclient-native>))

(dc <cclient-mailbox> (<any>))

 (dp current-box (<cclient-stream> => <cclient-mailbox>))

(df open-mail-stream (mailbox-name|<str> => <cclient-stream>)
  (def stream (new <cclient-stream>))
  (set (cc-handle stream) (mail_open NULL mailbox-name 0))
  stream
  )

;; === Abstracty Things ===

;; --- Mailbox ---

;; forwarded -- <cclient-mailbox>
 (dp name (<cclient-mailbox> => <str>))
 (dp num-msgs (<cclient-mailbox> => <int>))
 (dp source-stream (<cclient-mailbox> => <cclient-stream>))

(df make-client-mailbox (stream|<cclient-stream> => <cclient-mailbox>)
  (def box (new <cclient-mailbox>))
  (set (name box) (mail_stream_mailbox_get (cc-handle stream)))
  (set (num-msgs box) (mail_stream_nmsgs_get (cc-handle stream)))
  (set (source-stream box) stream)
  box
  )

(dm expunge (box|<cclient-mailbox>)
  )

; --- Address ---

(dc <cclient-address> (<any>))
 (dp persons-name (<cclient-address> => <str>))
 (dp mailbox-name (<cclient-address> => <str>))
 (dp host-name (<cclient-address> => <str>))

(df make-client-address (ccp|<loc> => <cclient-address>)
  (def addr (new <cclient-address>))
  (set (persons-name addr) (mail_address_personal_get ccp))
  (set (mailbox-name addr) (mail_address_mailbox_get ccp))
  (set (host-name addr) (mail_address_host_get ccp))
  addr
  )

(df make-client-addresses (ccp|<loc> => <col>)
  (packing
      (rep loop ((cur-pointer ccp))
        (unless (= NULL cur-pointer)
          (pack (make-client-address cur-pointer))
          (loop (mail_address_next_get cur-pointer))
          )
        )
    )
  )

; --- Envelope ---

(dc <cclient-envelope> (<any>))
 (dp to-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address>
 (dp cc-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address>
 (dp bcc-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address>
 (dp from-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address> 
    ;; Note, I'm not sure how you could end up with multiple senders, but this normalizes things for me
 (dp sender-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address>
 (dp reply-to-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address>
 (dp return-path-addrs (<cclient-envelope> => <col>)) ;; of <cclient-address> (probably just 1 for this)
 (dp in-reply-to (<cclient-envelope> => <str>)) ;; Message ID (should have sep class?)
 (dp message-id (<cclient-envelope> => <str>)) ;; message id
 (dp subject (<cclient-envelope> => <str>))
 (dp message-date (<cclient-envelope> => <str>)) ;; goo date structure (do we have one?)

(df make-client-envelope (ccp|<loc> => <cclient-envelope>)
  (def env (new <cclient-envelope>))
  ;; Addresses
  (set (to-addrs env) (make-client-addresses (mail_envelope_to_get ccp)))
  (set (cc-addrs env) (make-client-addresses (mail_envelope_cc_get ccp)))
  (set (bcc-addrs env) (make-client-addresses (mail_envelope_bcc_get ccp)))
  (set (from-addrs env) (make-client-addresses (mail_envelope_from_get ccp)))
  (set (sender-addrs env) (make-client-addresses (mail_envelope_sender_get ccp)))
  (set (reply-to-addrs env) (make-client-addresses (mail_envelope_sender_get ccp)))
  (set (return-path-addrs env) (make-client-addresses (mail_envelope_return_path_get ccp)))
  ;; Non-addresses
  (set (in-reply-to env) (mail_envelope_in_reply_to_get ccp))
  (set (message-id env) (mail_envelope_message_id_get ccp))
  (set (subject env) (mail_envelope_subject_get ccp))
  (set (message-date env) (mail_envelope_date_get ccp))
  env
  )

; --- Body ---
(dc <cclient-body> (<any>))
 (dp body-type (<cclient-body> => <sym>))
 (dp subtype (<cclient-body> => <str>))
 (dp body-id (<cclient-body> => <str>))
 (dp body-desc (<cclient-body> => <str>))

(df make-client-body (ccp|<loc> => <cclient-body>)
  (def bod (new <cclient-body>))
  (set (body-type bod)
       (case (mail_body_type_get ccp)
         ((TYPETEXT) 'TEXT)
         ((TYPEMULTIPART) 'MULTIPART)
         ((TYPEMESSAGE) 'MESSAGE)
         ((TYPEAPPLICATION) 'APPLICATION)
         ((TYPEAUDIO) 'AUDIO)
         ((TYPEIMAGE) 'IMAGE)
         ((TYPEVIDEO) 'VIDEO)
         ((TYPEOTHER) 'OTHER)))
  (set (subtype bod) (mail_body_subtype_get ccp))
  (set (body-id bod) (mail_body_id_get ccp))
  (set (body-desc bod) (mail_body_description_get ccp))

;;  (mail_free_body ccp)

  bod
  )
;; body... 

; --- Message ---
(dc <cclient-message> (<any>))

 (dp box (<cclient-message> => <cclient-mailbox>))
 (dp msgnum (<cclient-message> => <int>))
 (dp envelope (<cclient-message> => <cclient-envelope>))
 (dp body (<cclient-message> => <cclient-body>))

(dm get-msg (box|<cclient-mailbox> msgno|<int> => <cclient-message>)
  (def new-msg (new <cclient-message>))

  (def envbodytup (mail_fetch_structure (cc-handle (source-stream box)) msgno 0))
  (def henv (1st envbodytup))
  (def hbod (2nd envbodytup))

  (set (envelope new-msg) (make-client-envelope henv))
  (set (body new-msg) (make-client-body hbod))

  (set (msgnum new-msg) msgno)
  (set (box new-msg) box)
  
;;  (mail_free_envelope henv)
  new-msg
  )

(dm delete-message (stream|<cclient-stream> box|<cclient-mailbox> msgno|<int>)
  (mail_setflag (cc-handle stream) (to-str msgno) "\\Deleted")
  (decf (num-msgs box))
  )

(dm get-body-text (message|<cclient-message> => <str>)
  ;; We really should create a variant that allows embedded nulls.  (That's done by 
   ;; passing a length in.  Although that requires something better than YPsu, and therefore
   ;; special-casing.  OTOH, this is a blatant memory leak unless c-client keeps a handle
   ;; and we can tell it to gc it.  (Or we get boehm to go active.)
  (mail_fetch_body (cc-handle (source-stream (box message))) (msgnum message) "1" NULL 0)
  )

;; === Callbacks ===

(df callback-searched (stream number)
  )

(df callback-exists (stream number)
  )

(df callback-flags (stream number)
  )

(df callback-notify (stream string err-flag)
  )

(df callback-list (stream delimiter name attributes)
  )

(df callback-lsub (stream delimiter name attributes)
  )

(df callback-status (stream mailbox status)
  )

(df callback-log (string err-flag)
  (msg out "c-client error %d: %s\n" err-flag string)
  )

(df callback-dlog (string)
  (msg out "c-client error: %s\n" string)
  )

(df callback-login (mailbox trial)
  (tup "username" "password")
  )

(df callback-critical (stream)
  )

(df callback-nocritical (stream)
  )

(df callback-diskerror (stream errcode serious)
  )

(df callback-fatal (string)
  )

(df callback-cache (stream msgno op)
  )

;; Register these wonderful default callbacks

(set_cclient_callback CCALLBACK_LOG callback-log)
(set_cclient_callback CCALLBACK_DLOG callback-dlog)

(init_cclient)

(export
  <cclient-stream>

  <cclient-mailbox>
  num-msgs

  <cclient-body>
  body-type
  subtype
  body-id
  body-desc

  <cclient-message>
  box
  msgnum
  envelope
  body

  <cclient-address>
  persons-name
  persons-name-setter
  mailbox-name
  mailbox-name-setter
  host-name
  host-name-setter

  <cclient-envelope>
  to-addrs
  cc-addrs
  bcc-addrs
  from-addrs
  sender-addrs
  reply-to-addrs
  in-reply-to
  message-id
  subject
  message-date

  )

(export
  open-mail-stream
  make-client-mailbox
  get-msg
  get-body-text
  )