;;; xwem-tray.el --- Tray support for XWEM.

;; Copyright (C) 2003-2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: 1 Sep 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id: xwem-tray.el,v 1.9 2005/04/04 19:54:17 lg Exp $

;; This file is part of XWEM.

;; XWEM 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 2, or (at your option)
;; any later version.

;; XWEM 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:
;;
;; We should implement something like dockapp handler(or system tray),
;; that will be placed on free space of xwem-minibuffer or xwem-frame
;; and handle external X applications. It may receive some
;; ClientMessages and process them. Some of this ClientMessage should
;; be used to run elisp code.
;;
;; See how mbdock from matchbox made.
;;
;; xwem tray creates fake window which is only used to hold selection
;; needed for communicatio, xwem minibuffer window will be used for
;; holding apps.
;;
;;; TODO:
;;    - Proper possition in `xwem-minibuffer' calculation.
;;    - Run elisp support(almost already done).
;;

;;; Code:

(require 'xlib-tray)
(require 'xwem-load)
(require 'xwem-help)
(require 'xwem-manage)

;;; xwem tray constants
(defconst xwem-tc-dock-req 0 "Dock place request.")
(defconst xwem-tc-message 1 "Message from dock app.")
(defconst xwem-tc-cancel-message 2 "Cancels message.")
(defconst xwem-tc-run-lisp 3 "Evaluate emacs lisp string")

(defvar xwem-tray-message-hook 'xwem-tray-message-defhook
  "*Hook to be called whin new message from dock app.
Function will be called with arg - dockapp.")

(defcustom xwem-tray-id 0 "System tray identificator.")

(defcustom xwem-tray-name "xwem-tray"
  "X Name for xwem tray.")

(defcustom xwem-tray-class '("xwem-tray" "xwem-tray")
  "X Class for xwem tray")

(defconst xwem-tray-evmask (Xmask-or XM-SubstructureNotify
                                     XM-Exposure
                                     XM-StructureNotify
                                     XM-SubstructureRedirect
                                     XM-PropertyChange
                                     XM-ButtonPress
                                     XM-ButtonRelease))

;;; Configuration for xwem system tray
(defgroup xwem-tray nil
  "Group to customize XWEM system tray."
  :prefix "xwem-tray-"
  :group 'xwem)

(defcustom xwem-tray-use-groups nil
  "*Non-nil mean systray with use EXPERIMENTAL dockapp grouping.
Set it to non-nil on your own risk."
  :type 'boolean
  :group 'xwem-tray)

(defcustom xwem-tray-default-align 'right
  "*Position in minibuffer where dockapps will placed."
  :type '(choice (const :tag "At Right" right)
                 (const :tag "At Left" left))
  :group 'xwem-tray)

(defcustom xwem-tray-minib-start-offset 4
  "*Start offset in pixels."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-minib-dock-offset 5
  "*Offset in pixels between dockapps."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-groups-distance 5
  "*Minimum distance between systray groups."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-shape 'X-XC-right_ptr
  "*Cursor shape which will be used when pointer is over dock app."
  :type (xwem-cursor-shape-choice)
  :set (xwem-cus-set-cursor-shape
        xwem-tray-cursor
        (and (xwem-tray-p xwem-tray) (xwem-tray-xwin xwem-tray)))
  :initialize 'custom-initialize-default
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-foreground-color "#000075"
  "*Cursor's foreground color used when poniter is on dock app."
  :type 'color
  :set (xwem-cus-set-cursor-foreground xwem-tray-cursor)
  :initialize 'custom-initialize-default
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-background-color "#000039"
  "*Cursor's background color used when poniter is on dock app."
  :type 'color
  :set (xwem-cus-set-cursor-background xwem-tray-cursor)
  :initialize 'custom-initialize-default
  :group 'xwem-tray)

(define-xwem-face xwem-tray-group-face
  `(((light) (:foreground "white"))
    ((medium) (:foreground "gray50"))
    ((dark) (:foreground "black")))
  "*Face to outline dockapp groups."
  :group 'xwem-tray
  :group 'xwem-faces)

;;; Delimiter stuff
(defcustom xwem-tray-delimiter-width 4
  "*Delimiter width."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-delimiter-height-reminder 2
  "*How many pixels on top/bottom from xwem minibuffer.."
  :type 'number
  :group 'xwem-tray)

(define-xwem-face xwem-tray-delimiter-face
  `(((background light)
     (:foreground "gray40"))
    ((background light shadow)
     (:foreground "gray30"))
    ((background dark)
     (:foreground "gray70"))
    ((background dark shadow)
     (:foreground "gray80"))
    (t (:foreground "gray55")))
  "Face to draw systray delimiter."
  :group 'xwem-tray
  :group 'xwem-faces)

;;; Internal variables

(defvar xwem-tray-groups '("desktop"  "launch" "misc" "default")
  "List of valid dockapp groups.")

(defconst xwem-tray-align-left 1)
(defconst xwem-tray-align-right 2)


;;; Internal variables
(defvar xwem-tray nil
  "Default xwem system tray.")

(defvar xwem-tray-cursor nil
  "Cursor used when pointer is over dock app.")
(defvar xwem-tray-curroffset 0
  "Current offset in pixels.")

;;; Dock applications
;;
;; Dock is array in form:
;;  [x-window geom-after-reparent]
(defvar xwem-tray-dapp-list nil "List of dockapp X windows.")

;; System tray
(defstruct xwem-tray
  xwin                                  ; Tray's X window
  xgeom                                 ; Tray's X geometry
  atoms

  groups                                ; list of groups
  dockapps                              ; compatible with old style
  plist)                                ; tray properties

(defmacro xwem-tray-rem-prop (tray prop)
  "From TRAY's property list, remove property PROP."
  `(setf (xwem-tray-plist ,tray)
         (plist-remprop (xwem-tray-plist ,tray) ,prop)))
(defmacro xwem-tray-put-prop (tray prop val)
  "In TRAY's plist put PROP with VAL."
  `(if ,val
       (setf (xwem-tray-plist ,tray)
             (plist-put (xwem-tray-plist ,tray) ,prop ,val))
     (xwem-tray-rem-prop ,tray ,prop)))
(defmacro xwem-tray-get-prop (tray prop)
  "Get TRAY's property PROP."
  `(plist-get (xwem-tray-plist ,tray) ,prop))

(defstruct xwem-tray-group
  name                                  ; group name
  align                                 ; group align
  xwin                                  ; group window
  xgeom                                 ; group window geometry

  dockapps
  plist)                                ; properties

;; Dockapp structure
(defstruct xwem-dapp
  xwin
  geom

  group                                 ; group
  plist                                 ; dockapp properties

  ;; for xembed messaging
  mess-type
  mess-waitlen
  mess-currlen
  mess)

(defmacro xwem-dapp-alive-p (dapp)
  "Return non-nil if DAPP is alive dock application."
  `(and (xwem-dapp-p ,dapp)
        (memq ,dapp xwem-tray-dapp-list)))

(defmacro xwem-dapp-rem-prop (dapp prop)
  `(setf (xwem-dapp-plist ,dapp)
         (plist-remprop (xwem-dapp-plist dapp) ,prop)))

(defmacro xwem-dapp-put-prop (dapp prop val)
  `(if ,val
       (setf (xwem-dapp-plist ,dapp)
             (plist-put (xwem-dapp-plist ,dapp) ,prop ,val))
     (xwem-dapp-rem-prop ,dapp ,prop)))

(defmacro xwem-dapp-get-prop (dapp prop)
  `(plist-get (xwem-dapp-plist ,dapp) ,prop))

(defmacro xwem-dapp-group-name (dapp)
  `(xwem-dapp-get-prop ,dapp 'group))
(defsetf xwem-dapp-group-name (dapp) (group)
  `(xwem-dapp-put-prop ,dapp 'group ,group))

(defmacro xwem-dapp-id (dapp)
  `(xwem-dapp-get-prop ,dapp 'id))
(defsetf xwem-dapp-id (dapp) (id)
  `(xwem-dapp-put-prop ,dapp 'id ,id))

(defmacro xwem-dapp-align (dapp)
  `(xwem-dapp-get-prop ,dapp 'align))
(defsetf xwem-dapp-align (dapp) (align)
  `(xwem-dapp-put-prop ,dapp 'align ,align))

(defmacro xwem-dapp-state (dapp)
  `(xwem-dapp-get-prop ,dapp 'state))
(defsetf xwem-dapp-state (dapp) (state)
  `(xwem-dapp-put-prop ,dapp 'state ,state))

;; Message is vector in form:
;;  [message-type message-waitlen message-currlen message-string]

;; message-type is one of `xwem-tc-message', `xwem-tc-cancel-message'
;; or `xwem-tc-run-lisp'.

;;; Functions

;;{{{  [-] Groups

(defun xwem-tray-group-get-position (group)
  "Get good position in system tray for tray GROUP."
  (let ((groups (xwem-tray-groups xwem-tray))
        (dtlen xwem-tray-minib-start-offset))
    (while groups
      (when (eq (xwem-tray-group-align (car groups))
                (xwem-tray-group-align group))
        (incf dtlen (X-Geom-width (xwem-tray-group-xgeom (car groups))))
        (incf dtlen xwem-tray-groups-distance))
      (setq groups (cdr groups)))

    (ecase (xwem-tray-group-align group)
      (right
       (- (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))
          dtlen (X-Geom-width (xwem-tray-group-xgeom group))))
      (left
       (+ (X-Geom-width (xwem-minib-cl-xgeom xwem-minibuffer))
          dtlen)))))

(defun xwem-tray-group-find (name)
  "Search for tray group with NAME."
  (let ((groups (xwem-tray-groups xwem-tray)))
    (while (and groups
                (not (string= (xwem-tray-group-name (car groups)) name)))
      (setq groups (cdr groups)))
    (car groups)))

(defun xwem-tray-group-create (name &rest params)
  "Create and return new systray group, giving it NAME.
Additional PARAMS can be specified."
  (let ((xtg (apply 'make-xwem-tray-group :name name params)))
    (unless (xwem-tray-group-align xtg)
      (setf (xwem-tray-group-align xtg)
            xwem-tray-default-align))
    (unless (xwem-tray-group-xgeom xtg)
      (setf (xwem-tray-group-xgeom xtg)
            (make-X-Geom :x 0 :y 0 :width 16 :height 16)))

    (setf (X-Geom-x (xwem-tray-group-xgeom xtg))
          (xwem-tray-group-get-position xtg))
    (setf (xwem-tray-group-xwin xtg)
          (XCreateWindow
           (xwem-dpy) (xwem-tray-xwin xwem-tray)
           (X-Geom-x (xwem-tray-group-xgeom xtg))
           (X-Geom-y (xwem-tray-group-xgeom xtg))
           (X-Geom-width (xwem-tray-group-xgeom xtg))
           (X-Geom-height (xwem-tray-group-xgeom xtg))
           (X-Geom-border-width (xwem-tray-group-xgeom xtg))
           nil nil nil
           (make-X-Attr :override-redirect t
                        :background-pixel
                        (X-Gc-foreground
                         (xwem-face-get-gc 'xwem-tray-group-face '(medium)))
                        :event-mask (Xmask-or XM-ButtonPress
                                              XM-ButtonRelease))))

    ;; Add to tray's groups
    (setf (xwem-tray-groups xwem-tray)
          (cons xtg (xwem-tray-groups xwem-tray)))
    xtg))

(defun xwem-tray-group-same-align-sorted (group)
  "Return list of groups with same align as GROUP."
  (sort (delq nil (mapcar #'(lambda (g)
                              (and (eql (xwem-tray-group-align g)
                                        (xwem-tray-group-align g)) g))
                          (xwem-tray-groups xwem-tray)))
        #'(lambda (g1 g2)
            (> (X-Geom-x (xwem-tray-group-xgeom g1))
               (X-Geom-x (xwem-tray-group-xgeom g2))))))

(defun xwem-tray-group-resize (group new-width new-height)
  "Resize tray GROUP to NEW-WIDTH and NEW-HEIGHT."
  (let ((glist (xwem-tray-group-same-align-sorted group))
        (off (- new-width
                (X-Geom-width (xwem-tray-group-xgeom group)))))
    (if (eq (xwem-tray-group-align group) 'left)
        (setq glist (cdr (memq group glist)))
      (setq glist (cdr (memq group (nreverse glist)))
            off (- new-width)))

    (mapc #'(lambda (g)
              (incf (X-Geom-x (xwem-tray-group-xgeom g)) off)
              (XMoveWindow (xwem-dpy) (xwem-tray-group-xwin g)
                           (X-Geom-x (xwem-tray-group-xgeom g))
                           (X-Geom-y (xwem-tray-group-xgeom g))))
          glist)
    (incf (X-Geom-width (xwem-tray-group-xgeom group)) off)
    (XResizeWindow (xwem-dpy) (xwem-tray-group-xwin group)
                   (X-Geom-width (xwem-tray-group-xgeom group))
                   (X-Geom-height (xwem-tray-group-xgeom group)))
    ))

(defun xwme-tray-group-repositionate-dapps (group)
  "Repositionate GROUP's dock applications."
  (let ((gdapps (xwem-tray-group-dockapps group))
        (step 3)
        (coff 3))
    (while gdapps
      (setf (X-Geom-x (xwem-dapp-geom (car gdapps))) coff)
      ;; XXX do it deffering
      (XMoveWindow (xwem-dpy) (xwem-dapp-xwin (car gdapps))
                   (X-Geom-x (xwem-dapp-geom (car gdapps)))
                   (X-Geom-y (xwem-dapp-geom (car gdapps))))
      (incf coff (X-Geom-width (xwem-dapp-geom (car gdapps))))
      (incf coff step)
      (setq gdapps (cdr gdapps)))

    (when (> coff (X-Geom-width (xwem-tray-group-xgeom group)))
      (xwem-tray-group-resize
       group coff
       (X-Geom-height (xwem-tray-group-xgeom group))))))
  
(defun xwem-tray-group-attach-dapp (group dapp)
  "To tray GROUP attach dock application DAPP."
  (let ((gdapps (xwem-tray-group-dockapps group)))
    (XReparentWindow (xwem-dpy) (xwem-tray-group-xwin group)
                     (xwem-dapp-xwin dapp) 0 0)
    (while (and gdapps
                (> (xwem-dapp-id (car gdapps))
                   (xwem-dapp-id dapp)))
      (setq gdapps (cdr gdapps)))
    (if (not gdapps)
        (setf (xwem-tray-group-dockapps group)
              (append (xwem-tray-group-dockapps group)
                      (list dapp)))
      (setcdr gdapps (cons (car gdapps) (cdr gdapps)))
      (setcar gdapps dapp))

    (xwme-tray-group-repositionate-dapps group)))

(defun xwem-tray-group-find-create (name)
  "Find existing or create new group."
  (or (xwem-tray-group-find name)
      (xwem-tray-group-create name)))

;;}}}

;;;###xwem-autoload
(defun xwem-XTrayInit (xdpy xwin &optional dockid dockgroup dockalign)
  "Same as `XTrayInit'.
You should use this function instead of direct calls to `XTrayInit',
because in time you doing it xwem-tray may be uninitialised."
  (xwem-tray-startit xdpy)              ; make sure systray initialized

  (when dockid
    (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ID")
                     XA-integer X-format-16 X-PropModeReplace dockid))
  (when dockgroup
    (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_GROUP")
                     XA-string X-format-8 X-PropModeReplace dockgroup))
  (when dockalign
    (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ALIGN")
                     XA-integer X-format-16 X-PropModeReplace dockalign))
                                            
  (XTrayInit xdpy xwin))

;;;###xwem-autoload
(defun xwem-tray-find-dapp (xwin)
  "Finds dock application by X window XWIN."
  (car (member* xwin xwem-tray-dapp-list
                :test #'(lambda (xwin dapp)
                          (X-Win-equal xwin (xwem-dapp-xwin dapp))))))

(defun xwem-tray-message-defhook (dapp)
  "Default function for message from dock apps handling."
  (if (featurep 'xwem-special)
      (xwem-help-display "tray message"
        (insert (xwem-dapp-mess dapp)))
    (xwem-message 'error "Message arrived from dock app, but special frames not enabled.")))

;;; XXX these three functions:
;; 
;;  - xwem-tray-remove-dapp
;;  - xwem-tray-hide-dapp
;;  - xwem-tray-show-dapp
;; 
;; Has many of common code, get rid of it --lg

(defun xwem-tray-remove-dapp (dapp)
  "Remove dock application DAPP from xwem tray dockapps list."
  (let ((dgeom (xwem-dapp-geom dapp))
        (state (xwem-dapp-state dapp)))
    ;; Remove from dapps list
    (setq xwem-tray-dapp-list
          (delq dapp xwem-tray-dapp-list))
    (X-invalidate-cl-struct dapp)

    ;; Move other dapps to fill free space
    (unless (eq state 'hidden)
      (mapc #'(lambda (dapp)
                (ecase xwem-tray-default-align
                  (right
                   (when (< (X-Geom-x (xwem-dapp-geom dapp))
                            (X-Geom-x dgeom))
                     (xwem-tray-move-dapp dapp
                                          (+ (X-Geom-x (xwem-dapp-geom dapp))
                                             (X-Geom-width dgeom)
                                             xwem-tray-minib-dock-offset)
                                          (X-Geom-y (xwem-dapp-geom dapp)))))

                  (left
                   (when (> (X-Geom-x (xwem-dapp-geom dapp))
                            (X-Geom-x dgeom))
                     (xwem-tray-move-dapp dapp
                                          (- (X-Geom-x (xwem-dapp-geom dapp))
                                             (X-Geom-width dgeom)
                                             xwem-tray-minib-dock-offset)
                                          (X-Geom-y (xwem-dapp-geom dapp)))))))
            xwem-tray-dapp-list))))

(defun xwem-tray-hide-dapp (hide-dapp &optional unmap-p)
  "Hide dockapp DAPP temporary.
Non-nil UNMAP-P mean dockapp already unmapped."
  (unless (eq (xwem-dapp-state hide-dapp) 'hidden)
    (unless unmap-p
      (XUnmapWindow (xwem-dpy) (xwem-dapp-xwin hide-dapp)))
    (setf (xwem-dapp-state hide-dapp) 'hidden)

    (let ((dgeom (xwem-dapp-geom hide-dapp)))
      (mapc #'(lambda (dapp)
                (unless (eq dapp hide-dapp)
                  (ecase xwem-tray-default-align
                    (right
                     (when (< (X-Geom-x (xwem-dapp-geom dapp))
                              (X-Geom-x dgeom))
                       (xwem-tray-move-dapp dapp
                                            (+ (X-Geom-x (xwem-dapp-geom dapp))
                                               (X-Geom-width dgeom)
                                               xwem-tray-minib-dock-offset)
                                            (X-Geom-y (xwem-dapp-geom dapp)))))

                    (left
                     (when (> (X-Geom-x (xwem-dapp-geom dapp))
                              (X-Geom-x dgeom))
                       (xwem-tray-move-dapp dapp
                                            (- (X-Geom-x (xwem-dapp-geom dapp))
                                               (X-Geom-width dgeom)
                                               xwem-tray-minib-dock-offset)
                                            (X-Geom-y (xwem-dapp-geom dapp))))))))
            xwem-tray-dapp-list))))

(defun xwem-tray-show-dapp (show-dapp &optional map-p)
  "Show dockapp SHOW-DAPP that was hidden temporary.
Non-nil MAP-P mean dock app already mapped."
  (unless (eq (xwem-dapp-state show-dapp) 'shown)
    (unless map-p
      (XMapWindow (xwem-dpy) (xwem-dapp-xwin show-dapp)))
    (setf (xwem-dapp-state show-dapp) 'shown)
  
    (let ((dgeom (xwem-dapp-geom show-dapp)))
      (mapc #'(lambda (dapp)
                (unless (eq dapp show-dapp)
                  (ecase xwem-tray-default-align
                    (right
                     (when (< (X-Geom-x (xwem-dapp-geom dapp))
                              (+ (X-Geom-x dgeom) (X-Geom-width dgeom)))
                       (xwem-tray-move-dapp dapp
                                            (- (X-Geom-x (xwem-dapp-geom dapp))
                                               (X-Geom-width dgeom)
                                               xwem-tray-minib-dock-offset)
                                            (X-Geom-y (xwem-dapp-geom dapp)))))

                    (left
                     (when (> (X-Geom-x (xwem-dapp-geom dapp))
                              (+ (X-Geom-x dgeom) (X-Geom-width dgeom)))
                       (xwem-tray-move-dapp dapp
                                            (+ (X-Geom-x (xwem-dapp-geom dapp))
                                               (X-Geom-width dgeom)
                                               xwem-tray-minib-dock-offset)
                                            (X-Geom-y (xwem-dapp-geom dapp))))))))
            xwem-tray-dapp-list))))

(defun xwem-tray-get-proper-position (width)
  "Get good position in system tray for dapp with WIDTH."
  (let ((dapps xwem-tray-dapp-list)
        (dtlen xwem-tray-minib-start-offset))
    (while dapps
      (when (eq (xwem-dapp-state (car dapps)) 'shown)
        (incf dtlen (X-Geom-width (xwem-dapp-geom (car dapps))))
        (incf dtlen xwem-tray-minib-dock-offset))
      (setq dapps (cdr dapps)))
    
    (ecase xwem-tray-default-align
      (right
       (- (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))
          dtlen width))
      (left
       (+ (X-Geom-width (xwem-minib-cl-xgeom xwem-minibuffer))
          dtlen)))))

(define-xwem-deffered xwem-tray-apply-dapp-position (dapp)
  "Apply DAPP's position to life."
  (when (xwem-dapp-alive-p dapp)
    (XMoveWindow (xwem-dpy) (xwem-dapp-xwin dapp)
                 (X-Geom-x (xwem-dapp-geom dapp))
                 (X-Geom-y (xwem-dapp-geom dapp)))))

(defun xwem-tray-move-dapp (dapp new-x new-y)
  "Move DAPP to NEW-X, NEW-Y position.
If NEW-X or NEW-Y is nil - corresponding value is retained."
  (when new-x
    (setf (X-Geom-x (xwem-dapp-geom dapp)) new-x))
  (when new-y
    (setf (X-Geom-y (xwem-dapp-geom dapp)) new-y))
  (xwem-tray-apply-dapp-position dapp))

(defun xwem-tray-new-dapp (xwin)
  "New dock application XWIN wants to be managed."
  (let* ((minb-hei (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)))
         (wgeom (XGetGeometry (xwem-dpy) xwin))
         (w-wid (X-Geom-width wgeom))
         (w-hei (X-Geom-height wgeom))
         (dapp-geom (make-X-Geom
                     :x (xwem-tray-get-proper-position w-wid)
                     :y (/ (- minb-hei w-hei) 2)
                     :width w-wid :height w-hei))
         (dapp (make-xwem-dapp :xwin xwin :geom dapp-geom)))

    ;; Set DAPP's window gravity
    (XChangeWindowAttributes
     (xwem-dpy) xwin (make-X-Attr :win-gravity
				  (if (eq xwem-tray-default-align 'right)
				      X-EastGravity
				    X-WestGravity)))

    ;; Dockapp properties
    (setf (xwem-dapp-id dapp)
          (nth 2 (XGetWindowProperty
                  (xwem-dpy) xwin (XInternAtom (xwem-dpy) "XWEM_DOCK_ID"))))
    (setf (xwem-dapp-group-name dapp)
          (XGetPropertyString (xwem-dpy) xwin
                              (XInternAtom (xwem-dpy) "XWEM_DOCK_GROUP")))
    (setf (xwem-dapp-align dapp)
          (nth 2 (XGetWindowProperty
                  (xwem-dpy) xwin (XInternAtom (xwem-dpy) "XWEM_DOCK_ALIGN"))))

    (add-to-list 'xwem-tray-dapp-list dapp)

    (X-Win-EventHandler-add-new xwin 'xwem-dapp-handle-xevent
                                100 (list X-ClientMessage))

    (if xwem-tray-use-groups
        (xwem-tray-group-attach-dapp
         (xwem-tray-group-find-create (xwem-dapp-group-name dapp))
         dapp)
      (XReparentWindow (xwem-dpy) xwin (xwem-tray-xwin xwem-tray)
                       (X-Geom-x dapp-geom)
                       (X-Geom-y dapp-geom)))
    (XMapWindow (xwem-dpy) xwin)
    (setf (xwem-dapp-state dapp) 'shown)))

(defun xwem-dapp-handle-client-message (xev)
  "Handle ClientMessage from dock application."
  (xwem-debug 'xwem-tray "DOCK APP: ClientMessage")

  (let ((dapp (xwem-tray-find-dapp (X-Event-xclient-window xev)))
        (mes-type (X-Atom-id (X-Event-xclient-atom xev))))
    (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 9)))
           ;; part of some message arrived
           (let* ((len (- (xwem-dapp-mess-waitlen dapp)
                          (xwem-dapp-mess-currlen dapp)))
                  (ltgo (if (> len 20) 20 len))) ;length to go
             (setf (xwem-dapp-mess dapp)
                   (concat (xwem-dapp-mess dapp)
                           (xwem-list-to-string
                            (mapcar 'car (X-Event-xclient-msg xev)) ltgo)))
             (setf (xwem-dapp-mess-currlen dapp)
                   (+ (xwem-dapp-mess-currlen dapp) ltgo)))

           (when (= (xwem-dapp-mess-currlen dapp)
                    (xwem-dapp-mess-waitlen dapp))
             ;; message accomplished
             (let ((dtype (xwem-dapp-mess-type dapp)))
               (cond ((= dtype xwem-tc-message)
                      ;; TODO: run hook?
                      (when xwem-tray-message-hook
                        (funcall xwem-tray-message-hook dapp)))

                     ((= dtype xwem-tc-run-lisp)
                      (xwem-debug 'xwem-tray "DOCK APP: ELISP: '%s'"
                                  '(xwem-dapp-mess dapp))
                      (with-temp-buffer
                        (insert (xwem-dapp-mess dapp))
                        (condition-case nil
                            (progn
                              (xwem-message 'info "evaling: %S"
                                            (xwem-dapp-mess dapp))
                              (eval-buffer))
                          (t nil))))
                     ))))

          ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3)))
           ;; opcode arrived
           (let ((opc (truncate (car (nth 1 (X-Event-xclient-msg xev))))))
             (cond ((= opc xwem-tc-dock-req) nil)
                   (t (setf (xwem-dapp-mess dapp) "")
                      (setf (xwem-dapp-mess-currlen dapp) 0)
                      (setf (xwem-dapp-mess-waitlen dapp)
                            (truncate (car (nth 3 (X-Event-xclient-msg xev)))))
                      (setf (xwem-dapp-mess-type dapp) opc))
                   )))
          (t (xwem-message
              'warning "Unknown mes-type %d from dock app." mes-type)))
    nil))

(defun xwem-dapp-handle-xevent (xdpy xwin xev)
  "X Events handler for dockapps."
  (xwem-debug 'xwem-tray "DAPP: X Event: %S" '(X-Event-name xev))

  (X-Event-CASE xev
    (:X-ClientMessage
     (xwem-dapp-handle-client-message xev))
    ))
            
(defun xwem-tray-create (dpy)
  "Creates new XWEM system tray on DPY.
Window is InputOnly to be transparent."
  (let ((win nil))
    (setq win (XCreateWindow
               dpy nil
               0 0 1 1
               0 0 X-InputOnly nil
               (make-X-Attr :override-redirect t
                            :event-mask xwem-tray-evmask)))

    (X-Win-EventHandler-add-new win 'xwem-tray-handle-client-message
                                100 (list X-ClientMessage))
    
    ;; Setup various hints
    (XSetWMClass dpy win xwem-tray-class)
    (XSetWMName dpy win xwem-tray-name)

    (setf (xwem-tray-xwin xwem-tray) win)
    (setf (xwem-tray-plist xwem-tray) nil)

    ;; TODO: install Selections and properties we will need
    ))

(defun xwem-tray-init (dpy)
  "Initialize xwem tray."
  (setq xwem-tray
        (make-xwem-tray :atoms (make-vector 40 nil)
                        :xwin (xwem-minib-xwin xwem-minibuffer)))

  (let ((xwem-atoms (xwem-tray-atoms xwem-tray)))
    (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE"))
    (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK"))
    (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE"))
    (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO"))
    (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED"))
    (aset xwem-atoms 6 (XInternAtom dpy "MANAGER"))
    (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA"))
    (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH"))
    (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT"))
    (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON"))
    (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID"))
    (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID"))
    
    (aset xwem-atoms 30 (XInternAtom dpy "XWEM_DOCK_ID"))
    (aset xwem-atoms 31 (XInternAtom dpy "XWEM_DOCK_GROUP"))
    (aset xwem-atoms 32 (XInternAtom dpy "XWEM_DOCK_ALIGN"))

    ;; Use emacs pid as tray identificator
    (aset xwem-atoms 2
          (XInternAtom dpy (format "_NET_SYSTEM_TRAY_S%i" xwem-tray-id))))

  (setenv "SYSTEM_TRAY_ID" (format "%i" xwem-tray-id))

  ;; Subscribe on substructure change events for xwem tray window.
  (XSelectInput (xwem-dpy) (xwem-tray-xwin xwem-tray)
                (Xmask-or XM-SubstructureNotify XM-StructureNotify
                          (X-Attr-event-mask
                           (XGetWindowAttributes
                            (xwem-dpy) (xwem-tray-xwin xwem-tray)))))
  (X-Win-EventHandler-add-new (xwem-tray-xwin xwem-tray)
                              'xwem-tray-handle-xevent -1
                              (list X-MapNotify X-UnmapNotify
                                    X-DestroyNotify X-ConfigureNotify))
  (X-Win-EventHandler-add-new (xwem-tray-xwin xwem-tray)
                              'xwem-tray-handle-xevent 100
                              (list X-ClientMessage))

  ;; Configure systray cursor
  (setq xwem-tray-cursor
        (xwem-make-cursor xwem-tray-cursor-shape
                          xwem-tray-cursor-foreground-color
                          xwem-tray-cursor-background-color))
  (XSetWindowCursor (xwem-dpy) (xwem-tray-xwin xwem-tray)
                    xwem-tray-cursor))

(defun xwem-tray-handle-xevent (xdpy xwin xev)
  "X Events handler for xwem systray."
  (xwem-debug 'xwem-tray "TRAY X Event: %S" '(X-Event-name xev))

  (X-Event-CASE xev
    (:X-ClientMessage
     (let* ((mes-type (X-Atom-id (X-Event-xclient-atom xev)))
            (mes-data (X-Event-xclient-msg xev))
            (mes-win (X-Win-find-or-make (xwem-dpy) (car (nth 2 mes-data))))
            (data-type (truncate (car (nth 1 mes-data)))))
       (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3)))
              (cond ((= data-type xwem-tc-dock-req)
                     (xwem-debug 'xwem-tray "Creating new dockapp ..")
                     (xwem-tray-new-dapp mes-win))
                    (t (xwem-message
                        'warning "Unknown data-type %d in clientmessage."
                        data-type))))
             (t (xwem-message 'warning "Unknown mes-type %d" mes-type)))))

    (:X-DestroyNotify
     (let ((dapp (xwem-tray-find-dapp (X-Event-xdestroywindow-window xev))))
       (when (xwem-dapp-alive-p dapp)
         (xwem-message 'note "Removing dockapp ..")
         (xwem-tray-remove-dapp dapp))))

    (:X-UnmapNotify
     (let ((dapp (xwem-tray-find-dapp (X-Event-xunmap-window xev))))
       (when (xwem-dapp-alive-p dapp)
         (xwem-tray-hide-dapp dapp t))))

    (:X-MapNotify
     (let ((dapp (xwem-tray-find-dapp (X-Event-xunmap-window xev))))
       (when (xwem-dapp-alive-p dapp)
         (xwem-tray-show-dapp dapp t))))
    
    (:X-ConfigureNotify
     (when (eq (X-Event-xconfigure-window xev)
               (xwem-tray-xwin xwem-tray))
       (let ((height (X-Event-xconfigure-height xev)))
         (when (not (eql height
                         (xwem-tray-get-prop xwem-tray 'xwem-saved-height)))
           (xwem-tray-put-prop xwem-tray 'xwem-saved-height height)
           (mapc #'(lambda (dapp)
                     (setf (X-Geom-y (xwem-dapp-geom dapp))
                           (/ (- height (X-Geom-height (xwem-dapp-geom dapp))) 2))
                     (xwem-tray-apply-dapp-position dapp))
                 xwem-tray-dapp-list)))))))

(defun xwem-tray-startit (&optional dpy)
  "Start xwew tray on display DPY."
  (unless (get 'xwem-tray 'initialized)
    (unless dpy (setq dpy (xwem-dpy)))

    (xwem-tray-init dpy)
    (XSetSelectionOwner dpy (aref (xwem-tray-atoms xwem-tray) 2)
                        (xwem-tray-xwin xwem-tray))
    (XMapWindow dpy (xwem-tray-xwin xwem-tray))

    ;; Add finialization hook
    (add-hook 'xwem-exit-hook 'xwem-tray-fini)
    (put 'xwem-tray 'initialized t)))

(defun xwem-tray-fini ()
  "Finialize xwem-tray."
  (mapc #'(lambda (dapp)
            (XDestroyWindow (xwem-dpy) (xwem-dapp-xwin dapp)))
        xwem-tray-dapp-list)

  (setq xwem-tray-dapp-list nil)
  (setq xwem-tray-cursor nil)
  )

;;;###autoload
(defun xwem-tray-delimeter (&optional w h bgcol)
  "Add delimiter to dockapp.
W and H specifies delimiter width and height.
BGCOL - background color."
  (unless w
    (setq w xwem-tray-delimiter-width))
  (unless h
    (setq h (- (X-Geom-height (xwem-minib-cl-xgeom xwem-minibuffer))
               (* 2 xwem-tray-delimiter-height-reminder))))

  (let* ((bgmode (xwem-tray-background-mode))
         (bgcol (or bgcol (xwem-face-foreground 'xwem-tray-delimiter-face
                                                (list 'background bgmode))))
         (xwin (XCreateWindow
                (xwem-dpy) nil 0 0 w h
                0 nil nil nil
                (make-X-Attr
                 :override-redirect t
                 :cursor (xwem-make-cursor X-XC-sb_h_double_arrow)
                 :background-pixel
                 (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
                                   bgcol)
                 :event-mask (Xmask-or XM-ButtonPress
                                       XM-ButtonRelease XM-ButtonMotion)))))
    (xwem-XTrayInit (xwem-dpy) xwin)
    xwin))

;;;###xwem-autoload
(defun xwem-tray-background-mode ()
  "Return background mode(`dark' or `light') for system tray."
  (xwem-get-background-mode
   (face-background-instance 'default (xwem-minib-frame xwem-minibuffer))))

;;; System tray managing model
;;;###autoload
(defun xwem-manage-systray (cl)
  "Manage method for systray dockaps."
  (xwem-XTrayInit (xwem-dpy) (xwem-cl-xwin cl)))


(provide 'xwem-tray)

;;;; On-load actions:

;; Systray manage type 
(define-xwem-manage-model systray
  "Managing model for systray utilities."
  :manage-method 'xwem-manage-systray)

;; - Register xwem system tray
(if xwem-started
    (xwem-tray-startit)
  (add-hook 'xwem-after-init-hook 'xwem-tray-startit))

;;; xwem-tray.el ends here
