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

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: 1 Sep 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id: xwem-tray.el,v 1.3 2004/05/12 16:01:45 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:

;;; 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)

;;;###autoload
(defcustom xwem-tray-enabled t
  "*Non-nil mean that xwem's system tray will be used."
  :type 'boolean
  :group 'xwem-tray)

(defcustom xwem-tray-max-docks 6
  "*Maximum number of docks."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-minib-position 'right
  "*Position where dockapps will be placed in `xwem-minib-xwin'."
  :type '(choice (const :tag "At Right" right)
		 (const :tag "At Left" left))
  :group 'xwem-tray)

(defcustom xwem-tray-minib-posoffset 4
  "*Offset in pixels from `xwem-tray-minib-position'."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-minib-docoffset 5
  "*Offset in pixels between dockapps."
  :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)
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-foreground-color "#000075"
  "*Cursor's foreground color used when poniter is on dock app."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-background-color nil;"#000039"
  "*Cursor's background color used when poniter is on dock app."
  :type '(restricted-sexp :match-alternatives (nil xwem-misc-colorspec-valid-p))
  :group 'xwem-tray)

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

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

;;; 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
  props
  atoms

  curr-offset
  dockapps)

;; Dockapp structure
(defstruct xwem-dapp
  xwin
  geom
  mess-type
  mess-waitlen
  mess-currlen
  mess)

;; 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
(defun xwem-tray-find-dapp (xwin)
  "Finds dock application by X window XWIN."
  (let ((dal xwem-tray-dapp-list)
	(rdapp nil))
    (while dal
      (if (eq (xwem-dapp-xwin (car dal)) xwin)
	  (progn
	    (setq rdapp (car dal))
	    (setq dal nil))
	(setq dal (cdr dal))))
    rdapp))

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

(defun xwem-tray-remove-dapp (dapp)
  "Remove dock application DAPP from xwem tray dockapps list."
  (setq xwem-tray-dapp-list (delete dapp xwem-tray-dapp-list)))

(defun xwem-tray-new-dapp (xwin)
  "New dock application XWIN wants to be managed."
  (let* (;(minb-wid (X-Geom-width (xwem-minib-xgeom xwem-minibuffer)))
	 (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 0 :y 0 :width w-wid :height w-hei)))

    (setf (X-Geom-x dapp-geom)
	  (- xwem-tray-curroffset w-wid xwem-tray-minib-docoffset))
    (setf (X-Geom-y dapp-geom) (/ (- minb-hei w-hei) 2))
    (add-to-list 'xwem-tray-dapp-list (make-xwem-dapp :xwin xwin :geom dapp-geom))

    (setq xwem-tray-curroffset (X-Geom-x dapp-geom)) ;update curroffset

    (X-Win-EventHandler-add-new xwin 'xwem-dapp-evhandler 100)

    (XReparentWindow (xwem-dpy) xwin (xwem-minib-xwin xwem-minibuffer)
		     (X-Geom-x dapp-geom)
		     (X-Geom-y dapp-geom))
    (XMapWindow (xwem-dpy) xwin)
    ))

(defun xwem-tray-handle-client-message (win xev)
  "Handles ClientMessage from dock application WIN."
  (X-Dpy-log (xwem-dpy) "TRAY: ClientMessage, evinfo=%S\n" '(X-Event-evinfo xev))

  (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-tray-new-dapp mes-win))

		 (t (xwem-message 'warn "Unknown data-type %d in clientmessage." data-type))))

	  (t (xwem-message 'warn "Unknown mes-type %d" mes-type)))
  nil))

(defun xwem-tray-handle-unmap-or-destroy-notify (xdpy win xev)
  "Handles UnmapNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: UnmapNotify, evwin=%S, win=%S\n"
	     '(X-Win-id (X-Event-win xev)) '(X-Win-id (X-Event-xdestroywindow-window xev)))

  (let ((dapp (xwem-tray-find-dapp (X-Event-xdestroywindow-window xev))))
    (if dapp
	(progn
	  (xwem-message 'note "Removing dockapp from xwem tray.")
	  (xwem-tray-remove-dapp dapp)
	  ;; XXX: what if we removes not last dockapp?
	  (setq xwem-tray-curroffset
		(+ xwem-tray-curroffset
		   xwem-tray-minib-docoffset
		   (X-Geom-width (xwem-dapp-geom dapp))))
	  t)				;stop unmapnotify event processing
      nil)))				;continue processing

(defun xwem-tray-handle-prop-notify (win xev)
  "Handles PropertyNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: PropertyNotify\n")
  nil)

(defun xwem-tray-handle-expose (win xev)
  "Handles Exposure event."
  (X-Dpy-log (xwem-dpy) "TRAY: Exposure\n")
  nil)

(defun xwem-tray-handle-config-notify (win xev)
  "Handles ConfigureNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: ConfigureNotify\n")
  nil)

(defun xwem-tray-evhandler (xdpy win xev)
  "X Events handler for xwem system tray."
  (X-Dpy-log (xwem-dpy) "TRAY: event %S, descr: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev))

  (let* ((evtype (X-Event-type xev))
	 (fn (cond ((= evtype X-ClientMessage) 'xwem-tray-handle-client-message)
;		  ((= evtype X-MapRequest) nil)
;		  ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify)
;		  ((= evtype X-Expose) 'xwem-tray-handle-expose)
;		  ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify)
		  (t nil))))
    (when fn
      (funcall fn win xev))
  nil))

(defun xwem-dapp-handle-client-message (win xev)
  "Handle ClientMessage from dock application."
  (X-Dpy-log (xwem-dpy) "DOCK APP: ClientMessage\n")

  (let ((dapp (xwem-tray-find-dapp win))
	(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 (lambda (el) (car el)) (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)
		      (X-Dpy-log (xwem-dpy) "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 'warn "Unknown mes-type %d from dock app." mes-type)))
  nil))

(defun xwem-dapp-evhandler (xdpy win xev)
  "X Events handler for xwem dock applications."
  (X-Dpy-log (xwem-dpy) "DOCK APP: event %S,  info: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev))

  (let* ((evtype (X-Event-type xev))
	 (fn (cond ((= evtype X-ClientMessage) 'xwem-dapp-handle-client-message)
;		  ((= evtype X-MapRequest) nil)
;		  ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify)
;		  ((= evtype X-Expose) 'xwem-tray-handle-expose)
;		  ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify)
		  (t nil))))
    (when fn
      (funcall fn win xev))
  nil))

(defcustom xwem-tray-config nil
  "*Config file for xwem-tray.
It is list of vectors in form [TYPE VALUE], TYPE is one of XWEM-TRAY-DOCK where VALUE for it is a string, which will be runned with `background' or XWEM-TRAY-DILEM where VALUE is offset in pixels which should delim docks.

For example:
  '([XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minitime -f 004400 -b bbbbbb\"]
    [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-miniapm\"]
    [XWEM-TRAY-DELIM 10]
    [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minilaunch /home/lg/prog/xwem/modules/icons/xterm_big.xpm xterm\"]"
  :type 'list
  :group 'xwem-tray)

(defcustom xwem-tray-sit-for-pause 0.1
  "*Pause in seconds we should sit-for between launching XWEM-TRAY-DOCK.
UNUSED"
  :type 'number
  :group 'xwem-tray)

(defun xwem-tray-run-config (&optional config)
  "Parse and execute xwem tray CONFIG.
If CONFIG is ommited `xwem-tray-config' will be used."
  (unless config
    (setq config xwem-tray-config))

  (while config
    (let ((type (aref (car config) 0))
	  (data (aref (car config) 1)))
      (cond ((eq type 'XWEM-TRAY-DOCK)
	     (xwem-execute-program data))

	    ((eq type 'XWEM-TRAY-DELIM)
	     (setq xwem-tray-curroffset (- xwem-tray-curroffset data)))
	    (t nil)))
    (setq config (cdr config))))
	    
(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 1
			    :event-mask xwem-tray-evmask)))

    (X-Win-EventHandler-add-new win 'xwem-tray-evhandler 100)
    
    ;; 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-props xwem-tray) nil)

    ;; TODO: install Selections and properties we will need
    
;    (XMapWindow dpy win)
    ))

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

  (let ((xwem-atoms (xwem-tray-atoms xwem-tray)))
    (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE" nil))
    (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK" nil))
    (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE" nil))
    (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO" nil))
    (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED" nil))
    (aset xwem-atoms 6 (XInternAtom dpy "MANAGER" nil))
    (aset xwem-atoms 7 (XInternAtom dpy "_MB_DOCK_ALIGN" nil))
    (aset xwem-atoms 8 (XInternAtom dpy "_MB_DOCK_ALIGN_EAST" nil))
    (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA" nil))
    (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH" nil))
    (aset xwem-atoms 11 (XInternAtom dpy "WM_PROTOCOLS" nil))
    (aset xwem-atoms 12 (XInternAtom dpy "WM_DELETE_WINDOW" nil))
    (aset xwem-atoms 13 (XInternAtom dpy "_MB_THEME" nil))
    (aset xwem-atoms 14 (XInternAtom dpy "_MB_PANEL_TIMESTAMP" nil))
    (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT" nil))
    (aset xwem-atoms 16 (XInternAtom dpy "_MB_PANEL_BG" nil))
    (aset xwem-atoms 17 (XInternAtom dpy "WM_CLIENT_LEADER" nil))
    (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON" nil))
    (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID" nil))
    (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID" nil))

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

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

  ;; Must do:
  ;;	- Calculate start possition.
  ;;	- Add handler for UnmapNotify and DestroyNotify events.
  (cond ((eq xwem-tray-minib-position 'right)
	 (setq xwem-tray-curroffset
	       (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))))
	
	(t (xwem-message "Unsupported `xwem-tray-minib-position': %S"
			 xwem-tray-minib-position)))

  ;; Subscribe on substructure change events for xwem minibuffer
  ;; window.
  (setf (xwem-minib-evmask xwem-minibuffer)
	(Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-SubstructureNotify))
  (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
		(xwem-minib-evmask xwem-minibuffer))
  (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer)
			      'xwem-tray-handle-unmap-or-destroy-notify
			      -1 (list X-UnmapNotify X-DestroyNotify))
  
  ;; Configure systray cursor
  (setq xwem-tray-cursor (xwem-make-cursor (eval xwem-tray-cursor-shape)
					   xwem-tray-cursor-foreground-color
					   xwem-tray-cursor-background-color))

  (XChangeWindowAttributes (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
			   (make-X-Attr :cursor xwem-tray-cursor))
  )

;;;###autoload
(defun xwem-tray-startit (dpy)
  "Start xwew tray on display DPY."
  (xwem-tray-init dpy)

  (xwem-tray-create dpy)

  (XSetSelectionOwner dpy (aref (xwem-tray-atoms xwem-tray) 2)
		      (xwem-tray-xwin xwem-tray))
  ;; TODO: err check
  (XMapWindow dpy (xwem-tray-xwin xwem-tray))
  )

;;;###autoload
(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)
  (setq xwem-tray-curroffset 0)
  (setq xwem-tray-dockapps 0)
  )

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

(defcustom xwem-tray-delimiter-height 28
  "*Delimiter height."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-delimiter-background "gray40"
  "Background face for tray delimiter."
  :type '(restricted-sexp :match-alternatives (nil xwem-misc-colorspec-valid-p))
  :group 'xwem-tray)

;;;###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 xwem-tray-delimiter-height))
  (unless bgcol
    (setq bgcol xwem-tray-delimiter-background))

  (let ((xwin (XCreateWindow (xwem-dpy) nil 0 0 w h
                             0 nil nil nil
                             (make-X-Attr :override-redirect t
                                          :background-pixel (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
                                                                              bgcol)))))
    (XTrayInit (xwem-dpy) xwin)
    xwin))

(provide 'xwem-tray)

;;; xwem-tray.el ends here
