;;; client.el ---
;;
;; Copyright (C) 2010, 2011 Jan Moringen
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: telepathy, communication, instant messaging
;;
;; This Program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This Program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses>.


;;; Commentary:
;;


;;; History:
;;
;; 0.1 - Initial version


;;; Code:
;;

(require 'dbus)

(require 'telepathy/util)


;;;
;;

(defconst telepathy-client-introspection-data
  "<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\"
\"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">
<node name=\"/org/freedesktop/Telepathy/Client/%s\">
  <interface name=\"org.freedesktop.DBus.Introspectable\">
    <method name=\"Introspect\">
      <arg name=\"data\" direction=\"out\" type=\"s\"/>
    </method>
  </interface>
  <interface name=\"org.freedesktop.DBus.Properties\">
    <method name=\"Get\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"propname\" direction=\"in\" type=\"s\"/>
      <arg name=\"value\" direction=\"out\" type=\"v\"/>
    </method>
    <method name=\"Set\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"propname\" direction=\"in\" type=\"s\"/>
      <arg name=\"value\" direction=\"in\" type=\"v\"/>
    </method>
    <method name=\"GetAll\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"props\" direction=\"out\" type=\"a{sv}\"/>
    </method>
  </interface>
  <interface name=\"org.freedesktop.Telepathy.Client.Handler\">
    <method name=\"HandleChannels\">
      <arg name=\"Account\" type=\"o\" direction=\"in\"/>
      <arg name=\"Connection\" type=\"o\" direction=\"in\"/>
      <arg name=\"Channels\" type=\"a(oa{sv})\" direction=\"in\"/>
      <arg name=\"Requests_Satisfied\" type=\"ao\" direction=\"in\"/>
      <arg name=\"User_Action_Time\" type=\"t\" direction=\"in\"/>
      <arg name=\"Handler_Info\" type=\"a{sv}\" direction=\"in\"/>
    </method>
  </interface>
</node>"
  "")


;;;
;;

(defvar telepathy-client-handlers (make-hash-table :test 'equal)
  "")

(defun telepathy-client-handler-services ()
  ""
  (let ((result))
    (maphash (lambda (key value) (push key result))
	     telepathy-client-handlers)
    result))

(defun telepathy-client-add-handler (service handler &optional client)
  ""
  (unless client
    (setq client "Emacs"))

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-unregister client))

  (puthash service handler telepathy-client-handlers)

  (telepathy-client-register client))

(defun telepathy-client-remove-handler (service &optional client)
  ""
  (unless client
    (setq client "Emacs"))

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-unregister client))

  (remhash service telepathy-client-handlers)

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-register client)))


;;;
;;

(defun telepath-client-channel-handler (account connection-path channels &rest args)
  ""
  (dolist (channel-data channels)
    (let* ((connection         (telepathy-make-remote-proxy-from-path
				:session connection-path))

	   ;; Analyze the properties of the channel.
	   (channel-properties (second channel-data))

	   (contact-handle     (telepathy-prop-get
				telepathy-key-target-handle channel-properties))
	   (contact            (telepathy-make-contact
				connection contact-handle))

	   (service            (telepathy-prop-get
				telepathy-key-service channel-properties))
	   (handler            (gethash service telepathy-client-handlers))

	   ;; Obtain object path of channel object.
	   (channel-path       (first channel-data))
	   (channel-service    (let ((bla (telepathy-path->service channel-path)))
				 (substring bla 0 (position ?. bla :from-end t))))
	   (channel-object     (dbus-proxy-make-remote-proxy
				:session channel-service channel-path
				nil 'telepathy-tube))) ;; TODO could be a different kind of channel
      (oset channel-object :contact contact)

      (message "Channel")
      (message "  Path       %s" channel-path)
      (message "  Service    %s" service)
      (message "  Contact    %s" contact)
      (funcall handler channel-object)))
  :ignore)

(defun telepathy-client-register (name)
  ""
  ;; Create a DBus object to handle tube requests.
  (let ((service (format "org.freedesktop.Telepathy.Client.%s" name))
	(path    (format "/org/freedesktop/Telepathy/Client/%s" name)))
    ;; Install introspection information.
    (lexical-let ((introspection-data
		   (format telepathy-client-introspection-data name)))
      (dbus-register-method
       :session service path
       "org.freedesktop.DBus.Introspectable"
       "Introspect"
       (lambda (&rest args) introspection-data)
       t)) ;; don't request the name, yet

    ;; Register all properties belonging to the handler object.
    (dolist (name-and-value `(("HandlerChannelFilter"
			       ,(mapcar
				 #'telepathy-client-make-channel-filter
				 (telepathy-client-handler-services)))
			      ("BypassApproval"  t) ;; TODO was nil
			      ("Capabilities"    (:array :signature "as"))
			      ("HandledChannels" (:array :signature "ao"))))
      (destructuring-bind (name value) name-and-value
	(dbus-register-property
	 :session service path
	 "org.freedesktop.Telepathy.Client.Handler"
	 name :read value nil t))) ;; don't request the name, yet

    ;; TODO store the dbus objects for unregistering?
    (dbus-register-method
     :session service path
     "org.freedesktop.Telepathy.Client.Handler"
     "HandleChannels" #'telepath-client-channel-handler
     t) ;; don't request the name, yet

    (dbus-register-property
     :session service path
     "org.freedesktop.Telepathy.Client"
     "Interfaces"
     :read
     '("org.freedesktop.Telepathy.Client.Handler")
     nil t) ;; don't request the name, yet

    ;; Now that everything is in place, request the name.
    (dbus-call-method
     :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
     "RequestName" service 0)))

;; (/org/freedesktop/Telepathy/Connection/gabble/jabber/scymtym_2dtest_40jabber_2eorg_2fbe153d1c/StreamTubeChannel_2_1273735221
;;  ((org.freedesktop.Telepathy.Channel.InitiatorID
;;    (address@hidden))
;;   (org.freedesktop.Telepathy.Channel.TargetHandleType
;;    (1))
;;   (org.freedesktop.Telepathy.Channel.TargetHandle
;;    (2))
;;   (org.freedesktop.Telepathy.Channel.TargetID
;;    (address@hidden))
;;   (org.freedesktop.Telepathy.Channel.Requested
;;    (nil))
;;   (org.freedesktop.Telepathy.Channel.Type.StreamTube.SupportedSocketTypes
;;    (((0 (0 3)) (2 (0 1)) (3 (0 1)))))
;;   (org.freedesktop.Telepathy.Channel.Type.StreamTube.Service
;;    (org.gnu.emacs.rudel.announce))
;;   (org.freedesktop.Telepathy.Channel.Interface.Tube.Parameters
;;    (nil))
;;   (org.freedesktop.Telepathy.Channel.ChannelType
;;    (org.freedesktop.Telepathy.Channel.Type.StreamTube))
;;   (org.freedesktop.Telepathy.Channel.InitiatorHandle
;;    (2))
;;   (org.freedesktop.Telepathy.Channel.Interfaces
;;    ((org.freedesktop.Telepathy.Channel.Interface.Tube)))))

(defun telepathy-client-unregister (name)
  ""
  (dbus-unregister-service
   :session
   (format "org.freedesktop.Telepathy.Client.%s" name)))


;;; Helper functions
;;

(defun telepathy-client-make-channel-filter (service)
  ""
  `((:dict-entry
     "org.freedesktop.Telepathy.Channel.ChannelType"
     (:variant :string "org.freedesktop.Telepathy.Channel.Type.StreamTube"))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.TargetHandleType"
     (:variant :uint32 1))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.Requested"
     (:variant :boolean nil))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.Type.StreamTube.Service"
     (:variant :string ,service))
    ))

(provide 'telepathy/client)
;;; client.el ends here