;;; xwem-osd.el --- On Screen Display implementation for XWEM.

;; Copyright (C) 2004,2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Mon Jan 12 13:14:32 MSK 2004
;; Keywords: xwem
;; X-CVS: $Id: xwem-osd.el,v 1.7 2005-04-04 19:54:14 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:

;; Support for on screen display in XWEM.  xwem-osd can display text,
;; processing bar, other stuff using shaped window.  The main feature
;; of this OSD implementation that it uses OSD instances to display
;; stuff, so it does not need to handle expose events.

;; OSD supports system tray.  It is very easy to write OSD dockapp.
;; Simple example in xwem-framei.el.  You just create osd as usuall,
;; but using `xwem-osd-create-dock', where you can specify width,
;; height and keymap to use, for example:
;; 
;;    (setq myosd (xwem-osd-create-dock (xwem-dpy) 24 24 (list 'keymap myosd-keymap)))
;;    (xwem-osd-text myosd "test")
;; 
;; This will create dockapp in system tray, display "test" in it, and
;; will execute commands in `myosd-keymap' if you click on OSD.  To
;; define commands in `myosd-keymap' do something like:
;; 
;;    (define-key myosd-keymap [button1]
;;      (lambda () (interactive) (xwem-message 'info "Myosd Hello world!")))
;;    (define-key myosd-keymap [button3] 'myosd-popup-menu)
;; 

;; New instance type added - dots.  To poly dataset in OSD you can use
;; `xwem-osd-dots-add' function.  TYPE is one of:
;; 
;;    'points      - Little circles.
;;    'lines       - Lines
;;    'linespoints - Lines with points at ends.
;;    'impulses    - Impulses from 0 to dot's Y.
;;    'dots        - Tiny dots.
;;    'steps       - Steps around points
;;    'fsteps      - Another 'steps variant
;;    'histeps     - Yet another 'steps variant (NI)
;;    'boxes       - Boxes arount points (NI)
;; 
;; For example if you have some dataset(CPU load f.i.) which
;; represented in as list of cons cells, which car is X and cdr is Y.
;; 
;;   ds
;;   ==>
;;   ((1 . 3) (3 . 6) (5 . 4) (7 . 10) (9 . 10) (11 . 3))
;;
;;   (xwem-osd-dots-add myosd ds 'impulses "red4")
;; 
;; This will draw nice graph.
;; 
;; For full drawing posibilities consider `xwem-diagram.el'.

;;; Code:

(eval-when-compile
  (require 'cl))

(require 'xlib-xshape)
(require 'xlib-tray)
(require 'xlib-xpm)

(require 'xwem-diagram)

(defgroup xwem-osd nil
  "Group to customize OSD."
  :prefix "xwem-osd-"
  :group 'xwem-misc)

(defcustom xwem-osd-default-font "fixed"
  "Default font for text drawed in osd."
  :type 'string
  :group 'xwem-osd)

(defcustom xwem-osd-default-color "black"
  "Default color used to draw."
  :type 'color
  :group 'xwem-osd)

(defcustom xwem-osd-default-stack-rank 100
  "Default rank."
  :type 'number
  :group 'xwem-osd)

;;; Internal variables

(defconst xwem-osd-instance-types '(text line dots arc rect icon)
  "List of valid types of osd instance.")


(defstruct xwem-osd-instance
  type					; instance type, see `xwem-osd-instance-types'
  osd					; back reference to osd
  (depth 0)				; depth

  xwin xmask
  color                                 ; instance background color

  plist)                                ; User defined plist

(defsubst xwem-osd-instance-put-prop (osin prop val)
  "In OSD's instance OSIN properties list put property PROP with value VAL."
  (setf (xwem-osd-instance-plist osin)
        (plist-put (xwem-osd-instance-plist osin) prop val)))
(put 'xwem-osd-instance-put-prop 'lisp-indent-function 2)

(defsubst xwem-osd-instance-get-prop (osin prop)
  "Return OSD's instance OSIN property PROP."
  (plist-get (xwem-osd-instance-plist osin) prop))

(defsubst xwem-osd-instance-rem-prop (osin prop)
  "Remove OSD's instance OSIN property PROP."
  (setf (xwem-osd-instance-plist osin)
        (plist-remprop (xwem-osd-instance-plist osin) prop)))

(defmacro xwem-osd-instance-xdpy (osin)
  "Return display of OSIN osd instance."
  `(xwem-osd-xdpy (xwem-osd-instance-osd osin)))

(defstruct xwem-osd
  state					; 'destroyed, 'hided or 'shown
  x y width height

  xdpy
  xwin
  xmask

  gc					; GC used to draw
  mask-gc				; GC used to draw mask

  instances				; list of xwem-osd-instance structs sorted by depth

  plist)				; User defined plist

(defsubst xwem-osd-put-prop (osd prop val)
  "In OSD's properties list put property PROP with value VAL."
  (setf (xwem-osd-plist osd)
        (plist-put (xwem-osd-plist osd) prop val)))
(put 'xwem-osd-put-prop 'lisp-indent-function 2)

(defsubst xwem-osd-get-prop (osd prop)
  "Return OSD's property PROP."
  (plist-get (xwem-osd-plist osd) prop))

(defsubst xwem-osd-rem-prop (osd prop)
  "Remove OSD's property PROP."
  (setf (xwem-osd-plist osd)
        (plist-remprop (xwem-osd-plist osd) prop)))

(defmacro xwem-osd-xwin-copy (osd)
  `(xwem-osd-get-prop ,osd 'xwin-copy))
(defsetf xwem-osd-xwin-copy (osd) (xwin)
  `(xwem-osd-put-prop ,osd 'xwin-copy ,xwin))


;;; Functions
(defun xwem-osd-event-handler (xdpy xwin xev)
  "On X display XDPY and window XWIN handle X Event XEV."
  (let* ((osd (xwem-osd-get-osd xwin))
         (keymap (xwem-osd-get-prop osd 'keymap)))
    (when (xwem-osd-p osd)
      (X-Event-CASE xev
        (:X-DestroyNotify
         (xwem-osd-destroy osd t))

        ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
         (when (keymapp keymap)
           (xwem-overriding-local-map keymap
             (xwem-dispatch-command-xevent xev)))))
      )))

;;; Instances operations
(defun xwem-osd-instance-destroy (osin)
  "Destroy osd instance OSIN."
  (let ((xdpy (xwem-osd-instance-xdpy osin)))
    (XDestroyWindow xdpy (xwem-osd-instance-xwin osin))
    (XFreeColors xdpy (XDefaultColormap xdpy)
                 (list (xwem-osd-instance-color osin)) nil)
    (XFreePixmap xdpy (xwem-osd-instance-xmask osin))

    (X-invalidate-cl-struct osin)))

(defun xwem-osd-add-instance (osd depth &optional color)
  "In OSD add osd instance with background COLOR.
Return newly created osd instance."
  (unless depth
    (setq depth 0))
  (unless color
    (setq color
          (or (X-Color-name (X-Gc-foreground (xwem-osd-gc osd)))
              xwem-osd-default-color)))

  (let* ((xdpy (xwem-osd-xdpy osd))
         (osin (make-xwem-osd-instance
                :osd osd :depth depth
                :color (XAllocNamedColor xdpy (XDefaultColormap xdpy)
                                         color))))
    (setf (xwem-osd-instance-xwin osin)
	  (XCreateWindow xdpy (xwem-osd-xwin osd)
			 0 0 (xwem-osd-width osd) (xwem-osd-height osd)
			 0 nil nil nil
			 (make-X-Attr :override-redirect t
				      :background-pixel (xwem-osd-instance-color osin))))
    (setf (xwem-osd-instance-xmask osin)
	  (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
			 (xwem-osd-instance-xwin osin) 1
			 (xwem-osd-width osd) (xwem-osd-height osd)))
    (xwem-osd-instance-clear osin)

    (push osin (xwem-osd-instances osd))

    ;; - Sort instances according to depth
    ;; - Install below sibling
    (setf (xwem-osd-instances osd)
          (sort (xwem-osd-instances osd)
                (lambda (s1 s2)
                  (< (xwem-osd-instance-depth s1) (xwem-osd-instance-depth s2)))))

    (let ((siblings (xwem-osd-instances osd))
          below-sibl)
      (while siblings
        (if (>= (xwem-osd-instance-depth (car siblings)) depth)
            (setq siblings nil)
          (setq below-sibl (car siblings)))
        (setq siblings (cdr siblings)))

      (when below-sibl
        (XConfigureWindow xdpy (xwem-osd-instance-xwin osin)
                          (make-X-Conf :sibling (xwem-osd-instance-xwin below-sibl)
                                       :stackmode X-Below))))
    osin))

(defun xwem-osd-instance-clear (osin)
  "Clear mask area of OSD instance."
  (let ((osd (xwem-osd-instance-osd osin)))
    (xwem-osd-mask-fgbg osd)
    (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
		    0 0 (xwem-osd-width osd) (xwem-osd-height osd))
    (xwem-osd-mask-fgbg osd)))

(defun xwem-osd-instance-show (osin)
  "Show osd instance OSIN."
  (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin)))

(defun xwem-osd-instance-set-color (osin new-color)
  "Set new color."
  (let ((xdpy (xwem-osd-instance-xdpy osin)))
    (XFreeColors xdpy (XDefaultColormap xdpy)
                 (list (xwem-osd-instance-color osin)) nil)
    (setf (xwem-osd-instance-color osin)
          (XAllocNamedColor xdpy (XDefaultColormap xdpy)
                            new-color))
    (XSetWindowBackground xdpy (xwem-osd-instance-xwin osin)
                          (xwem-osd-instance-color osin))
    (XClearArea xdpy (xwem-osd-instance-xwin osin)
		0 0 (xwem-osd-width (xwem-osd-instance-osd osin))
		(xwem-osd-height (xwem-osd-instance-osd osin)) nil)))

;;; OSD functions
;;;###autoload
(defun xwem-osd-create (xdpy x y width height &optional x-parent properties)
  "On X display XDPY create new xwem osd context with +X+Y/WIDTHxHEIGHT geometry on X-PARENT.
PROPERTIES is a plist for osd.  Supported properties are:
 
 'keymap     - Keymap for OSD.
 'stack-rank - Rank of OSD in windows stack."
  (let ((osd (make-xwem-osd :xdpy xdpy
                            :x x :y y :width width :height height
                            :plist properties))
        (keymap (plist-get properties 'keymap))
        (stack-rank (plist-get properties 'stack-rank)))
    (setf (xwem-osd-xwin osd)
	  (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy))
			 x y width height 0 nil nil nil
			 (make-X-Attr :override-redirect t
				      :background-pixel (XBlackPixel xdpy)
				      :event-mask (Xmask-or XM-StructureNotify
                                                            (if keymap
                                                                (Xmask-or XM-KeyPress
                                                                          XM-ButtonPress
                                                                          XM-ButtonRelease)
                                                              0)))))
    ;; Apply STACK-RANK
    (when stack-rank
      (xwem-misc-set-xwin-always-on-top (xwem-osd-xwin osd) stack-rank))

    ;; Create gc
    (setf (xwem-osd-gc osd)
	  (XCreateGC xdpy (xwem-osd-xwin osd)
		     (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
				:foreground (XAllocNamedColor xdpy (XDefaultColormap xdpy)
							      xwem-osd-default-color)
				:font (X-Font-get xdpy xwem-osd-default-font))))

    (X-Win-put-prop (xwem-osd-xwin osd) 'osd-ctx osd)
    (X-Win-EventHandler-add-new (xwem-osd-xwin osd) 'xwem-osd-event-handler)

    (xwem-osd-create-mask osd)
    osd))

;;;###autoload
(defun xwem-osd-create-dock (xdpy width height &optional properties)
  "Create docked osd instance.
XDPY - Display.
X, Y, WIDTH, HEIGHT - OSD Geometry."
  (let ((osd (xwem-osd-create xdpy 0 0 width height nil properties)))
    (xwem-osd-clear osd)
    (xwem-XTrayInit xdpy (xwem-osd-xwin osd))
    osd))

(defun xwem-osd-get-osd (xwin)
  "Get osd context associated with XWIN."
  (and (X-Win-p xwin) (X-Win-get-prop xwin 'osd-ctx)))

(defun xwem-osd-mask-fgbg (osd)
  "Exchange foreground and background colors in OSD's mask gc."
  (let* ((mgc (xwem-osd-mask-gc osd))
	 (fg (X-Gc-foreground mgc))
	 (bg (X-Gc-background mgc)))
    (setf (X-Gc-foreground mgc) bg)
    (setf (X-Gc-background mgc) fg)
    
    (XChangeGC (xwem-osd-xdpy osd) mgc)))

(defun xwem-osd-clear-mask (osd)
  "Clear mask area of OSD context."
  (xwem-osd-mask-fgbg osd)
  (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
		  0 0 (xwem-osd-width osd) (xwem-osd-height osd))
  (xwem-osd-mask-fgbg osd))
  
(defun xwem-osd-create-mask (osd)
  "For xwem osd context OSD create mask pixmap."
  (let ((xdpy (xwem-osd-xdpy osd)))
    (setf (xwem-osd-xmask osd)
	  (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
			 (xwem-osd-xwin osd) 1 (xwem-osd-width osd)
			 (xwem-osd-height osd)))
    (unless (xwem-osd-mask-gc osd)
      (setf (xwem-osd-mask-gc osd)
            (XCreateGC xdpy (xwem-osd-xmask osd)
                       (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
                                  :foreground 1.0
                                  :background 0.0
                                  :font (X-Font-get xdpy xwem-osd-default-font)))))
    (xwem-osd-clear-mask osd)))

(defun xwem-osd-set-height (osd new-height)
  "Set OSD's window height to NEW-HEIGHT."
  (setf (xwem-osd-height osd) new-height)
  (XResizeWindow (xwem-osd-xdpy osd)
		 (xwem-osd-xwin osd)
		 (xwem-osd-width osd)
		 (xwem-osd-height osd))

  (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
  (xwem-osd-create-mask osd))

(defun xwem-osd-set-width (osd new-width)
  "Set OSD's window width to NEW-WIDTH."
  (setf (xwem-osd-width osd) new-width)
  (XResizeWindow (xwem-osd-xdpy osd)
		 (xwem-osd-xwin osd)
		 (xwem-osd-width osd)
		 (xwem-osd-height osd))

  (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
  (xwem-osd-create-mask osd))

(defun xwem-osd-move (osd new-x new-y)
  "Change OSD's window position to NEW-X, NEW-Y."
  (XMoveWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
	       new-x new-y))

(defun xwem-osd-set-xwin-color (osd color-name)
  "Set background for OSD's window to COLOR-NAME."
  (let ((xdpy (xwem-osd-xdpy osd)))
    (XSetWindowBackground xdpy (xwem-osd-xwin osd)
			  (XAllocNamedColor xdpy (XDefaultColormap xdpy)
					    color-name))))

(defun xwem-osd-set-gc-color (osd color-name)
  "Set OSD's gc foreground color to COLOR-NAME."
  (let ((xdpy (xwem-osd-xdpy osd)))
    (setf (X-Gc-foreground (xwem-osd-gc osd))
	  (XAllocNamedColor xdpy (XDefaultColormap xdpy)
			    color-name))
    (XChangeGC xdpy (xwem-osd-gc osd))))

(defun xwem-osd-set-color (osd color-name)
  "Set both OSD's background and OSD's gc foreground color to COLOR-NAME."
  (let* ((xdpy (xwem-osd-xdpy osd))
	 (col (XAllocNamedColor xdpy (XDefaultColormap xdpy)
				color-name)))
    (XSetWindowBackground xdpy (xwem-osd-xwin osd) col)
    (xwem-osd-clear-xwin osd)
    (setf (X-Gc-foreground (xwem-osd-gc osd)) col)
    (XChangeGC xdpy (xwem-osd-gc osd))))

(defun xwem-osd-show (osd)
  "Show OSD's window."
  (xwem-osd-apply-xmask-1 osd)
  (XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))
  (xwem-misc-raise-xwin (xwem-osd-xwin osd))

  (setf (xwem-osd-state osd) 'shown))

(defun xwem-osd-hide (osd)
  "Hide OSD's window."
  (XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))

  (setf (xwem-osd-state osd) 'hidden))

(defun xwem-osd-destroy-instances (osd)
  "Destroy all instances in OSD."
  (mapc 'xwem-osd-instance-destroy (xwem-osd-instances osd))
  (setf (xwem-osd-instances osd) nil))

(defun xwem-osd-destroy (osd &optional already-destroyed)
  "Destroy OSD context."
  (xwem-osd-destroy-instances osd)

  (X-Win-EventHandler-rem (xwem-osd-xwin osd) 'xwem-osd-event-handler)
  (X-Win-rem-prop (xwem-osd-xwin osd) 'osd-ctx)
  
  (unless already-destroyed
    (XDestroyWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)))
  (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
  (XFreeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd))
  (XFreeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd))

  (X-invalidate-cl-struct osd))

(defun xwem-osd-set-font (osd font-name)
  "In OSD's context set font to be FONT-NAME."
  (let* ((xdpy (xwem-osd-xdpy osd))
	 (gc (xwem-osd-gc osd))
	 (mgc (xwem-osd-mask-gc osd))
	 (font (X-Font-get xdpy font-name)))
    (setf (X-Gc-font mgc) font)
    (XChangeGC xdpy mgc)

    (setf (X-Gc-font gc) font)
    (XChangeGC xdpy gc)))

(defun xwem-osd-char-width (osd)
  "Return width of OSD's window in characters."
  ;; XXX assumes that font is width fixed
  (/ (xwem-osd-width osd)
     (X-Text-width (xwem-osd-xdpy osd) (X-Gc-font (xwem-osd-mask-gc osd)) "_")))

(defun xwem-osd-clear-xwin (osd)
  "Clear contents of OSD's window."
  (XClearArea (xwem-osd-xdpy osd) (xwem-osd-xwin osd) 0 0
	      (xwem-osd-width osd) (xwem-osd-height osd) nil))

(defun xwem-osd-clear (osd)
  "Clear OSD window."
  (xwem-osd-destroy-instances osd)
  (xwem-osd-clear-mask osd)
  (xwem-osd-apply-xmask osd))

(define-xwem-deffered xwem-osd-apply-xmask (osd)
  "Apply OSD's mask to life."
  (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
		X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)))

(defun xwem-osd-text (osd string)
  "In OSD's context show STRING.
If OSD has any instances, they will be destroyed."
  (let* ((xdpy (xwem-osd-xdpy osd))
	 (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)
		  (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string))))

    (xwem-osd-destroy-instances osd)
    ;; Update window shape
    (xwem-osd-clear-mask osd)
    (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
		 0 yoff string)
    (xwem-osd-apply-xmask osd)))

(defun xwem-osd-color-text (osd strspec-list)
  "In OSD's win draw colored text specified by STRSPEC-LIST."
  (xwem-osd-clear osd)
  (let ((curstr ""))
    (mapcar (lambda (strspec)
              (let* ((xdpy (xwem-osd-xdpy osd))
                     (str (concat curstr (car strspec)))
                     (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str)
                              (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str))))
                (xwem-osd-set-xwin-color osd (cdr strspec))
                (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
                             0 yoff str)
                (xwem-osd-apply-xmask osd)
		
                (setq curstr (concat curstr (car strspec)))))
            strspec-list)))
    
(defun xwem-osd-text-add (osd x y string &optional depth color)
  "In OSD's context at X Y coordinates add STRING colored with COLOR."
  (let* ((xdpy (xwem-osd-xdpy osd))
	 (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)
		  (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)))
	 osin)

    ;; Setup OSD instance
    (setq osin (xwem-osd-add-instance osd depth color))
    (setf (xwem-osd-instance-type osin) 'text)
    (XDrawString xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
		 x (+ y yoff) string)
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (xwem-osd-instance-show osin)

    ;; Update window shape
    (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
		 x (+ y yoff) string)
    (xwem-osd-apply-xmask osd)
    osin))

(defun xwem-osd-set-line-width (osd new-line-width)
  "Set OSD's gc line width to NEW-LINE-WIDTH."
  (setf (X-Gc-line-width (xwem-osd-gc osd)) new-line-width)
  (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd))

  (setf (X-Gc-line-width (xwem-osd-mask-gc osd)) new-line-width)
  (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd))
  )

(defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional depth color)
  "In OSD's window add line."
  (let ((xdpy (xwem-osd-xdpy osd))
	osin)
    
    ;; Create OSD line instance
    (setq osin (xwem-osd-add-instance osd depth color))
    (setf (xwem-osd-instance-type osin) 'line)
    (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
	       x0 y0 x1 y1)
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (xwem-osd-instance-show osin)

    ;; Update OSD window shape
    (XDrawLine xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
	       x0 y0 x1 y1)
    (xwem-osd-apply-xmask osd)
    osin))

(defun xwem-osd-dots-add (osd dots type &optional depth color)
  "In OSD's window add DOTS of TYPE."
  (let ((xdpy (xwem-osd-xdpy osd))
        osin)

    ;; Create OSD dots instancne
    (setq osin (xwem-osd-add-instance osd depth color))
    (setf (xwem-osd-instance-type osin) 'dots)
    (xwem-diag-plot-dots type (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
                         0 (xwem-osd-height osd) dots)
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (xwem-osd-instance-show osin)

    ;; Update OSD window shape
    (xwem-diag-plot-dots type (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
                         0 (xwem-osd-height osd) dots)
    (xwem-osd-apply-xmask osd)
    osin))

(defun xwem-osd-arc-add (osd xarc &optional depth color)
  "In OSD's window draw arc specified by XARC."
  (let ((xdpy (xwem-osd-xdpy osd))
	osin)

    ;; Create OSD arc instance
    (setq osin (xwem-osd-add-instance osd depth color))
    (setf (xwem-osd-instance-type osin) 'arc)
    (XDrawArcs xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
	       (list xarc))
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (xwem-osd-instance-show osin)

    ;; Update OSD shape
    (XDrawArcs xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
	       (list xarc))
    (xwem-osd-apply-xmask osd)
    osin))

(defun xwem-osd-rect-add (osd x y width height &optional depth color fill-p)
  "In OSD's window add rectangle specified by X Y WIDTH and HEIGHT.
If FILL-P is non-nil, rectangle will be filled instead of outdrawing."
  (let ((xdpy (xwem-osd-xdpy osd))
	osin)

    ;; Created OSD rect instance
    (setq osin (xwem-osd-add-instance osd depth color))
    (setf (xwem-osd-instance-type osin) 'rect)
    (XDrawRectangles xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
                     (list (make-X-Rect :x x :y y :width width :height height))
                     fill-p)
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (xwem-osd-instance-show osin)

    ;; Update OSD shape
    (XDrawRectangles xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
                     (list (make-X-Rect :x x :y y :width width :height height))
                     fill-p)
    (xwem-osd-apply-xmask osd)
    osin))

(defun xwem-osd-icon-data-add (osd xpm-data &optional x y depth)
  "In OSD's window add icon.
X and Y specifies osd instance location inside OSD(default is 0 0).
DEPTH specifies osd instance depth(default is 0).
XPM-DATA string of xpm image."
  (unless depth
    (setq depth 0))
  (unless x
    (setq x 0))
  (unless y
    (setq y 0))

  (let ((xdpy (xwem-osd-xdpy osd))
	osin xpix xpix-mask)

    ;; Created OSD icon instance
    (setq osin (xwem-osd-add-instance osd depth))
    (setf (xwem-osd-instance-type osin) 'icon)

    (setq xpix (X:xpm-pixmap-from-data
                xdpy (xwem-osd-instance-xwin osin) xpm-data)
          xpix-mask (X:xpm-pixmap-from-data
                     xdpy (xwem-osd-instance-xwin osin) xpm-data t))

    (XCopyArea xdpy xpix-mask (xwem-osd-instance-xmask osin)
               xwem-misc-mask-bgc 0 0
               (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
               x y)
    (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
                  X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
    (XCopyArea xdpy xpix-mask (xwem-osd-xmask osd)
               xwem-misc-mask-bgc 0 0
               (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
               x y)
    (xwem-osd-apply-xmask osd)

    (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-osd-instance-xwin osin) xpix)

    (xwem-osd-instance-show osin)
    osin))

(defun xwem-osd-icon-file-add (osd xpm-file &optional x y depth)
  "Same as `xwem-osd-icon-data-add', but takes xpm image from FILE."
  (let (xpm-data)
    (with-temp-buffer
      (insert-file-contents-literally xpm-file)
      (setq xpm-data (buffer-substring)))

  (xwem-osd-icon-data-add osd xpm-data x y depth)))

(defun xwem-osd-offscreen (osd)
  "Put OSD off the screen, displaying OSD copy.
Usefull to prevent flicking."
  (if (xwem-osd-xwin-copy osd)
      (XResizeWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)
                     (xwem-osd-width osd) (xwem-osd-height osd))
    (setf (xwem-osd-xwin-copy osd)
          (XCreateWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
                         0 0
                         (xwem-osd-width osd) (xwem-osd-height osd)
                         0
                         nil nil nil (make-X-Attr :override-redirect t))))

  (XCopyArea (xwem-osd-xdpy osd)
             (xwem-osd-xwin osd) (xwem-osd-xwin-copy osd)
             (xwem-osd-gc osd)
             0 0 (xwem-osd-width osd) (xwem-osd-height osd)
             0 0)
  (XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)))

(defun xwem-osd-commit (osd)
  "Commit changes made while OSD was in off screen."
  (XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)))

;;; You might consider more powerfull `working' package, which is part
;;; of CEDET.
(defun xwem-osd-working-bar-display (tot-len percents)
  "Return a string with a bar-graph end percentile showing percentage.
TOT-LEN is the total length of bar.  PERCENTS is percentage state."
  (let* ((prstr (int-to-string percents))
	 (len (- tot-len (+ 10 (length prstr))))
	 (dcs (truncate (* len (/ percents 100.0))))
	 (tlen (- len dcs)))
    (concat ": ["
	    (make-string (if (> dcs 0) dcs 0) ?#)
	    (make-string (if (> tlen 0) tlen 0) ?.)
	    "] ... " prstr "%")))

(defun xwem-osd-working-percent-bar (osd prompt percents)
  "Display percentage with PERCENTS done bar prompting PROMPT."
  (require 'working)

  (let ((osdcw (xwem-osd-char-width osd)))
    (xwem-osd-text osd (concat prompt (xwem-osd-working-bar-display (- osdcw (length prompt)) percents)))))

					
;;; Testing:
;;  (setq mosd (xwem-osd-create (xwem-dpy) 10 20 400 200))
;;  (xwem-osd-set-color mosd "green4")
;;  (xwem-osd-set-font mosd "10x20")
;;  (xwem-osd-text mosd "test")
;;  (xwem-osd-show mosd)
    
;;  (progn
;;    (setq i 0)
;;    (xwem-osd-show mosd)
;;    (xwem-osd-set-color mosd "red4")
;;    (while (< i 100)
;;      (cond ((= i 60) (xwem-osd-set-color mosd "green4"))
;;          ((= i 30) (xwem-osd-set-color mosd "yellow4")))
;;      (xwem-osd-working-percent-bar mosd "Processing" i)
;;      (sleep-for 0.01)
;;      (incf i 1))
;;    (xwem-osd-set-color mosd "red4")
;;    (xwem-osd-text mosd "Processing done."))
    
;;  (xwem-osd-destroy mosd)

;; Here is example from Steve Youngs <steve@xwem.org> to
;; display date using OSD:

;; (require 'xwem-osd)
;; (defvar sy-osd-date nil)
;; (copy-face 'default 'sy-osd-date-face)
;; (set-face-foreground 'sy-osd-date-face "blanchedalmond")

;; (defvar sy-osd-date-keymap
;;   (let ((map (make-sparse-keymap 'sy-osd-date-keymap)))
;;     (define-key map [button3] '(lambda () (interactive) (calendar)))
;;     map)
;;   "Keymap for date OSD.")

;; (defun sy-show-date-osd ()
;;   "*Display the current date using OSD."
;;   (interactive)
;;   (let* ((face `sy-osd-date-face)
;; 	 (text (format-time-string "%a, %b %e"))
;; 	 (width (+ 3 (X-Text-width
;; 		      (xwem-dpy)
;; 		      (X-Font-get (xwem-dpy)
;; 				  (face-font-name face))
;; 		      text)))
;; 	 (height (+ 3 (X-Text-height
;; 		       (xwem-dpy)
;; 		       (X-Font-get (xwem-dpy)
;; 				   (face-font-name face))
;; 		       text))))
;;     (setq sy-osd-date (xwem-osd-create-dock
;; 		       (xwem-dpy)
;; 		       width
;; 		       height
;; 		       (list 'keymap sy-osd-date-keymap)))
;;     (xwem-osd-set-color sy-osd-date (face-foreground-name face))
;;     (xwem-osd-set-font sy-osd-date (face-font-name face))
;;     (xwem-osd-text sy-osd-date text)
;;     (xwem-osd-show sy-osd-date)))

;; (defun sy-update-osd-date-maybe (&optional force)
;;   "Update the OSD date at midnight.

;;  Optional Argument FORCE means to update the date now."
;;   (let* ((now (decode-time))
;; 	 (cur-hour (nth 2 now))
;; 	 (cur-min (nth 1 now))
;; 	 (cur-comp-time (+ (* cur-hour 60) cur-min)))
;;     (when (or force (= 0 cur-comp-time))
;;       (when (xwem-osd-p sy-osd-date)
;; 	(xwem-osd-text sy-osd-date (format-time-string "%a, %b %e"))))))

;; (defun sy-update-osd-date ()
;;   "*Force update of the OSD date."
;;   (interactive)
;;   (when (xwem-osd-p sy-osd-date)
;;     (sy-update-osd-date-maybe t)))

;; (defun sy-delete-osd-date ()
;;   "*Delete the OSD date."
;;   (interactive)
;;   (when (xwem-osd-p sy-osd-date)
;;     (when (itimerp "sy-osd-date-itimer")
;;       (delete-itimer "sy-osd-date-itimer"))
;;     (xwem-osd-destroy sy-osd-date)))

;; (add-hook 'xwem-after-init-hook (lambda ()
;; 				  (progn
;; 				    (sy-show-date-osd)
;; 				    (start-itimer "sy-osd-date-itimer"
;; 						  'sy-update-osd-date-maybe
;; 						  60 60))))



(provide 'xwem-osd)

;;; xwem-osd.el ends here