;;; xwem-time.el --- Time Date Load and Mail display in tray.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Mon Dec  8 09:53:42 MSK 2003
;; Keywords: xwem, xlib
;; X-CVS: $Id: xwem-time.el,v 1.3 2004/05/05 22:43:06 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:

;; `display-time' like application, which starts in system tray and
;; shows current time, load average and mail status.
;;
;; To start using it, add:
;;
;;    (autoload 'xwem-time "xwem-time" "Start `display-time' like app in system tray.")
;;    (add-hook 'xwem-after-init-hook 'xwem-time)
;;
;; to your xwemrc.

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

(require 'time)

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

(defgroup xwem-time nil
  "Group to customize XWEM time display."
  :prefix "xwem-time-"
  :group 'xwem)

(defcustom xwem-time-display-time t
  "*Non-nil mean display current time."
  :type 'boolean
  :group 'xwem-time)

(defcustom xwem-time-display-load t
  "*Non-nil mean display current CPU load."
  :type 'boolean
  :group 'xwem-time)

(defcustom xwem-time-display-mail t
  "*Non-nil mean display current mail box status."
  :type 'boolean
  :group 'xwem-time)

(defcustom xwem-time-time-color "#CA1E1C"
  "Foreground color to display time."
  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
  :group 'xwem-time)

(defcustom xwem-time-load-list
  (list 0.2 0.5 0.8 1.1 1.8 2.6)
  "*A list giving six thresholds for the load
which correspond to the six different icons to be displayed
as a load indicator."
  :type '(list (number :tag "Threshold 1")
	       (number :tag "Threshold 2")
	       (number :tag "Threshold 3")
	       (number :tag "Threshold 4")
	       (number :tag "Threshold 5")
	       (number :tag "Threshold 6"))
  :group 'xwem-time)

(defcustom xwem-time-interval 20
  "*Seconds between updates of xwem time window."
  :type 'integer
  :group 'xwem-time)


;;; Internal variables
(defconst xwem-time-window-mask (list XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease))
(defvar xwem-time-window "Window of to show time, load and mail.")
(defvar xwem-time-mask-gc "GC used to operate with mask pixmap.")
(defvar xwem-time-gc "GC used to operate with pixmaps.")


;;; Icons
(defvar xwem-time-xpm-time0 '(concat "/* XPM */\n"
				     "static char *noname[] = {\n"
				     "/* width height ncolors chars_per_pixel */\n"
				     "\"9 13 2 1\",\n"
				     "/* colors */\n"
				     "\"`	c None    s ledbg\",\n"
				     "\"a	c " xwem-time-time-color " s ledfg\",\n"
				     "/* pixels */\n"
				     "\"`````````\",\n"
				     "\"````aaaaa\",\n"
				     "\"```a````a\",\n"
				     "\"```a````a\",\n"
				     "\"``a````a`\",\n"
				     "\"``a````a`\",\n"
				     "\"`````````\",\n"
				     "\"`a````a``\",\n"
				     "\"`a````a``\",\n"
				     "\"a````a```\",\n"
				     "\"a````a```\",\n"
				     "\"aaaaa````\",\n"
				     "\"`````````\"\n"
				     "};\n"))

(defvar xwem-time-xpm-time1 '(concat "/* XPM */\n"
				     "static char *noname[] = {\n"
				     "/* width height ncolors chars_per_pixel */\n"
				     "\"9 13 2 1\",\n"
				     "/* colors */\n"
				     "\"`	c None s ledbg\",\n"
				     "\"a	c " xwem-time-time-color " s ledfg\",\n"
				     "/* pixels */\n"
				     "\"`````````\",\n"
				     "\"`````````\",\n"
				     "\"````````a\",\n"
				     "\"````````a\",\n"
				     "\"```````a`\",\n"
				     "\"```````a`\",\n"
				     "\"`````````\",\n"
				     "\"``````a``\",\n"
				     "\"``````a``\",\n"
				     "\"`````a```\",\n"
				     "\"`````a```\",\n"
				     "\"`````````\",\n"
				     "\"`````````\"\n"
				     "};\n"))

(defconst xwem-time-xpm-time2 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"````````a\",\n"
				       "\"````````a\",\n"
				       "\"```````a`\",\n"
				       "\"```````a`\",\n"
				       "\"``aaaaa``\",\n"
				       "\"`a```````\",\n"
				       "\"`a```````\",\n"
				       "\"a````````\",\n"
				       "\"a````````\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time3 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"````````a\",\n"
				       "\"````````a\",\n"
				       "\"```````a`\",\n"
				       "\"```````a`\",\n"
				       "\"``aaaaa``\",\n"
				       "\"``````a``\",\n"
				       "\"``````a``\",\n"
				       "\"`````a```\",\n"
				       "\"`````a```\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time4 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"`````````\",\n"
				       "\"```a````a\",\n"
				       "\"```a````a\",\n"
				       "\"``a````a`\",\n"
				       "\"``a````a`\",\n"
				       "\"``aaaaa``\",\n"
				       "\"``````a``\",\n"
				       "\"``````a``\",\n"
				       "\"`````a```\",\n"
				       "\"`````a```\",\n"
				       "\"`````````\",\n"
				       "\"`````````\"\n"
				       "};\n"))


(defconst xwem-time-xpm-time5 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"```a`````\",\n"
				       "\"```a`````\",\n"
				       "\"``a``````\",\n"
				       "\"``a``````\",\n"
				       "\"``aaaaa``\",\n"
				       "\"``````a``\",\n"
				       "\"``````a``\",\n"
				       "\"`````a```\",\n"
				       "\"`````a```\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time6 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"```a`````\",\n"
				       "\"```a`````\",\n"
				       "\"``a``````\",\n"
				       "\"``a``````\",\n"
				       "\"``aaaaa``\",\n"
				       "\"`a````a``\",\n"
				       "\"`a````a``\",\n"
				       "\"a````a```\",\n"
				       "\"a````a```\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time7 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"````````a\",\n"
				       "\"````````a\",\n"
				       "\"```````a`\",\n"
				       "\"```````a`\",\n"
				       "\"`````````\",\n"
				       "\"``````a``\",\n"
				       "\"``````a``\",\n"
				       "\"`````a```\",\n"
				       "\"`````a```\",\n"
				       "\"`````````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time8 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"```a````a\",\n"
				       "\"```a````a\",\n"
				       "\"``a````a`\",\n"
				       "\"``a````a`\",\n"
				       "\"``aaaaa``\",\n"
				       "\"`a````a``\",\n"
				       "\"`a````a``\",\n"
				       "\"a````a```\",\n"
				       "\"a````a```\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-time9 '(concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"9 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` c None    s ledbg\",\n"
				       "\"a c " xwem-time-time-color " s ledfg\",\n"
				       "/* pixels */\n"
				       "\"`````````\",\n"
				       "\"````aaaaa\",\n"
				       "\"```a````a\",\n"
				       "\"```a````a\",\n"
				       "\"``a````a`\",\n"
				       "\"``a````a`\",\n"
				       "\"``aaaaa``\",\n"
				       "\"``````a``\",\n"
				       "\"``````a``\",\n"
				       "\"`````a```\",\n"
				       "\"`````a```\",\n"
				       "\"aaaaa````\",\n"
				       "\"`````````\"\n"
				       "};\n"))

(defconst xwem-time-xpm-am '(concat "/* XPM */\n"
				    "static char *noname[] = {\n"
				    "/* width height ncolors chars_per_pixel */\n"
				    "\"4 13 2 1\",\n"
				    "/* colors */\n"
				    "\"` c None    s ledbg\",\n"
				    "\"a c " xwem-time-time-color " s ledfg\",\n"
				    "/* pixels */\n"
				    "\"````\",\n"
				    "\"``aa\",\n"
				    "\"``aa\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\"\n"
				    "};\n"))

(defconst xwem-time-xpm-dp '(concat "/* XPM */\n"
				    "static char *noname[] = {\n"
				    "/* width height ncolors chars_per_pixel */\n"
				    "\"9 13 2 1\",\n"
				    "/* colors */\n"
				    "\"` c None    s ledbg\",\n"
				    "\"a c " xwem-time-time-color " s ledfg\",\n"
				    "/* pixels */\n"
				    "\"`````````\",\n"
				    "\"`````````\",\n"
				    "\"`````````\",\n"
				    "\"`````````\",\n"
				    "\"````a````\",\n"
				    "\"````a````\",\n"
				    "\"`````````\",\n"
				    "\"```a`````\",\n"
				    "\"```a`````\",\n"
				    "\"`````````\",\n"
				    "\"`````````\",\n"
				    "\"`````````\",\n"
				    "\"`````````\"\n"
				    "};\n"))

(defconst xwem-time-xpm-pm '(concat "/* XPM */\n"
				    "static char *noname[] = {\n"
				    "/* width height ncolors chars_per_pixel */\n"
				    "\"4 13 2 1\",\n"
				    "/* colors */\n"
				    "\"` c None    s ledbg\",\n"
				    "\"a c " xwem-time-time-color " s ledfg\",\n"
				    "/* pixels */\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"````\",\n"
				    "\"aa``\",\n"
				    "\"aa``\",\n"
				    "\"````\"\n"
				    "};\n"))
;; load icons
(defconst xwem-time-xpm-load00 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 2 1\",\n"
				       "/* colors */\n"
				       "\"` s None c None\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"``````....\",\n"
				       "\"``````....\",\n"
				       "\"`````.....\",\n"
				       "\"`````.....\",\n"
				       "\"````......\",\n"
				       "\"````......\",\n"
				       "\"```.......\",\n"
				       "\"```.......\",\n"
				       "\"``........\",\n"
				       "\"``........\",\n"
				       "\"`.........\",\n"
				       "\"`.........\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load05 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 3 1,\"\n"
				       "\/* colors \*/\n"
				       "\"` s None c None\",\n"
				       "\"a c #0AB224\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"``````....\",\n"
				       "\"``````....\",\n"
				       "\"`````.....\",\n"
				       "\"`````.....\",\n"
				       "\"````......\",\n"
				       "\"````......\",\n"
				       "\"```.......\",\n"
				       "\"```.......\",\n"
				       "\"``........\",\n"
				       "\"``........\",\n"
				       "\"`.........\",\n"
				       "\"`aaaaaaaaa\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load10 (concat "/* XPM */"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 3 1\",\n"
				       "\/* colors \*/\n"
				       "\"` s None c None\",\n"
				       "\"a c #0AB224\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"``````....\",\n"
				       "\"``````....\",\n"
				       "\"`````.....\",\n"
				       "\"`````.....\",\n"
				       "\"````......\",\n"
				       "\"````......\",\n"
				       "\"```.......\",\n"
				       "\"```.......\",\n"
				       "\"``........\",\n"
				       "\"``aaaaaaaa\",\n"
				       "\"`.........\",\n"
				       "\"`aaaaaaaaa\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load15 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 4 1\",\n"
				       "/* colors */\n"
				       "\"` s None c None\",\n"
				       "\"a c #2AD244\",\n"
				       "\"b c #DEE614\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"``````....\",\n"
				       "\"``````....\",\n"
				       "\"`````.....\",\n"
				       "\"`````.....\",\n"
				       "\"````......\",\n"
				       "\"````......\",\n"
				       "\"```.......\",\n"
				       "\"```bbbbbbb\",\n"
				       "\"``........\",\n"
				       "\"``aaaaaaaa\",\n"
				       "\"`.........\",\n"
				       "\"`aaaaaaaaa\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load20 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 4 1\",\n"
				       "/* colors */\n"
				       "\"` s None c None\",\n"
				       "\"a c #0AB224\",\n"
				       "\"b c #DEE614\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"``````....\",\n"
				       "\"``````....\",\n"
				       "\"`````.....\",\n"
				       "\"`````.....\",\n"
				       "\"````......\",\n"
				       "\"````bbbbbb\",\n"
				       "\"```.......\",\n"
				       "\"```bbbbbbb\",\n"
				       "\"``........\",\n"
				       "\"``aaaaaaaa\",\n"
				       "\"`.........\",\n"
				       "\"`aaaaaaaaa\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load25 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 5 1\",\n"
				       "/* colors */\n"
				       "\"a s None c None\",\n"
				       "\"` c #FE0204\",\n"
				       "\"b c #0AB224\",\n"
				       "\"c c #DEE614\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"aaaaaa....\",\n"
				       "\"aaaaaa....\",\n"
				       "\"aaaaa.....\",\n"
				       "\"aaaaa`````\",\n"
				       "\"aaaa......\",\n"
				       "\"aaaacccccc\",\n"
				       "\"aaa.......\",\n"
				       "\"aaaccccccc\",\n"
				       "\"aa........\",\n"
				       "\"aabbbbbbbb\",\n"
				       "\"a.........\",\n"
				       "\"abbbbbbbbb\",\n"
				       "\"..........\"\n"
				       "};\n"))

(defconst xwem-time-xpm-load30 (concat "/* XPM */\n"
				       "static char *noname[] = {\n"
				       "/* width height ncolors chars_per_pixel */\n"
				       "\"10 13 5 1\",\n"
				       "/* colors */\n"
				       "\"a s None c None\",\n"
				       "\"` c #FE0204\",\n"
				       "\"b c #0AB224\",\n"
				       "\"c c #DEE614\",\n"
				       "\". s pad-color c #606060\",\n"
				       "/* pixels */\n"
				       "\"aaaaaa....\",\n"
				       "\"aaaaaa````\",\n"
				       "\"aaaaa.....\",\n"
				       "\"aaaaa`````\",\n"
				       "\"aaaa......\",\n"
				       "\"aaaacccccc\",\n"
				       "\"aaa.......\",\n"
				       "\"aaaccccccc\",\n"
				       "\"aa........\",\n"
				       "\"aabbbbbbbb\",\n"
				       "\"a.........\",\n"
				       "\"abbbbbbbbb\",\n"
				       "\"..........\"\n"
				       "};\n"))

;; Mail icons
(defconst xwem-time-xpm-letter (concat "/* XPM */\n"
				       "static char * jmail_xpm[] = {\n"
				       "\"18 13 4 1\",\n"
				       "\" 	s None c None\",\n"
				       "\".	c gray85\",\n"
				       "\"X	c yellow\",\n"
				       "\"o	c black\",\n"
				       "\"                  \",\n"
				       "\"                  \",\n"
				       "\"   .XXXXXXXXXXX.  \",\n"
				       "\"   XoXXXXXXXXXoXoo\",\n"
				       "\"   XXoXXXXXXXoXXoo\",\n"
				       "\"   XXXoXXXXXoXXXoo\",\n"
				       "\"   XXX.oXXXo.XXXoo\",\n"
				       "\"   XXXo.oXo.oXXXoo\",\n"
				       "\"   XXoXXXoXXXoXXoo\",\n"
				       "\"   XoXXXXXXXXXoXoo\",\n"
				       "\"   .XXXXXXXXXXX.oo\",\n"
				       "\"     ooooooooooooo\",\n"
				       "\"     ooooooooooooo\"};\n"))

(defconst xwem-time-xpm-no-letter (concat "/* XPM */\n"
					  "static char * jmail_xpm[] = {\n"
					  "\"18 13 4 1\",\n"
					  "\" 	s None	c None\",\n"
					  "\".	c gray55\",\n"
					  "\"o	c black\",\n"
					  "\"x	c gray95\",\n"
					  "\"                  \",\n"
					  "\"                  \",\n"
					  "\"   ooooooooooooox \",\n"
					  "\"   o.xxxxxxxxx.ox \",\n"
					  "\"   oxox      oxox \",\n"
					  "\"   ox ox    ox ox \",\n"
					  "\"   ox  ox  ox  ox \",\n"
					  "\"   ox oxoxoxox ox \",\n"
					  "\"   oxox  ox  oxox \",\n"
					  "\"   o.x        .ox \",\n"
					  "\"   ooooooooooooox \",\n"
					  "\"   xxxxxxxxxxxxxx \",\n"
					  "\"                  \"};\n"))



;;; Functions
(defsubst xwem-time-get-image (win img-type img-name)
  "In WIN's list of IMG-TYPE images get image with name IMG-NAME."
  (plist-get (X-Win-get-prop win img-type) img-name))

(defsubst xwem-time-get-mask (win mask-type mask-name)
  "In WIN's list of MASK-TYPE masks get mask with name MASK-NAME."
  (plist-get (X-Win-get-prop win mask-type) mask-name))

(defsubst xwem-time-get-time-image (win name)
  "In WIN's time images list get image with NAME."
  (xwem-time-get-image win 'xwem-time-images name))

(defsubst xwem-time-get-time-mask (win name)
  "In WIN's time masks list get mask with NAME."
  (xwem-time-get-mask win 'xwem-time-masks name))

(defsubst xwem-time-get-load-image (win name)
  "In WIN's load images list get image with NAME."
  (xwem-time-get-image win 'xwem-load-images name))

(defsubst xwem-time-get-load-mask (win name)
  "In WIN's load masks list get mask with NAME."
  (xwem-time-get-mask win 'xwem-load-masks name))

(defsubst xwem-time-get-mail-image (win name)
  "In WIN's mail images list get image with NAME."
  (xwem-time-get-image win 'xwem-mail-images name))

(defsubst xwem-time-get-mail-mask (win name)
  "In WIN's mail masks list get mask with NAME."
  (xwem-time-get-mask win 'xwem-mail-masks name))

(defsubst xwem-time-put-image (win img-type img-name img-data)
  (X-Win-put-prop win img-type
		  (plist-put (X-Win-get-prop win img-type) img-name img-data)))
  
(defsubst xwem-time-put-time-image (win name img)
  "In WIN's images list put parsed image with NAME.
Parsed image is IMG."
  (xwem-time-put-image win 'xwem-time-images name img))

(defsubst xwem-time-put-load-image (win name img)
  "In WIN's images list put parsed image with NAME.
Parsed image is IMG."
  (xwem-time-put-image win 'xwem-load-images name img))

(defsubst xwem-time-put-mail-image (win name img)
  "In WIN's images list put parsed image with NAME.
Parsed image is IMG."
  (xwem-time-put-image win 'xwem-mail-images name img))

(defun xwem-time-clear-mask (win)
  "Get WIN's mask pixmap and clear it's area."
  (let ((xdpy (X-Win-dpy win))
	(mask-pix (X-Win-get-prop win 'mask-pixmap))
	mgc)
    (setq mgc (XCreateGC xdpy mask-pix
			 (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
                                    :graphics-exposures X-False
				    :foreground 0.0
				    :background 1.0)))
    (XFillRectangle xdpy mask-pix mgc 0 0 88 15)
    (XFreeGC xdpy mgc)))

(defun xwem-time-init (xdpy)
  (let ((gc-cons-threshold most-positive-fixnum)	; inhibit gcing
	win time-images load-images mail-images
	time-masks load-masks mail-masks
	mask-pix)
    (setq win (XCreateWindow xdpy (XDefaultRootWindow xdpy)
			     0 0 88 15 0 nil nil nil
			     (make-X-Attr :background-pixel (XWhitePixel xdpy)
					  :border-pixel (XBlackPixel xdpy)
                                          :backing-store X-WhenMapped
					  :override-redirect t
					  )))

    (setq time-images (list 'time0 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time0))
			    'time1 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time1))
			    'time2 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time2))
			    'time3 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time3))
			    'time4 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time4))
			    'time5 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time5))
			    'time6 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time6))
			    'time7 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time7))
			    'time8 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time8))
			    'time9 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time9))
			    'time-am (X:xpm-img-from-data xdpy (eval xwem-time-xpm-am))
			    'time-pm (X:xpm-img-from-data xdpy (eval xwem-time-xpm-pm))
			    'time-dp (X:xpm-img-from-data xdpy (eval xwem-time-xpm-dp))))
    (setq load-images (list 'load00 (X:xpm-img-from-data xdpy xwem-time-xpm-load00)
			    'load05 (X:xpm-img-from-data xdpy xwem-time-xpm-load05)
			    'load10 (X:xpm-img-from-data xdpy xwem-time-xpm-load10)
			    'load15 (X:xpm-img-from-data xdpy xwem-time-xpm-load15)
			    'load20 (X:xpm-img-from-data xdpy xwem-time-xpm-load20)
			    'load25 (X:xpm-img-from-data xdpy xwem-time-xpm-load25)
			    'load30 (X:xpm-img-from-data xdpy xwem-time-xpm-load30)))
    (setq mail-images (list 'letter (X:xpm-img-from-data xdpy xwem-time-xpm-letter)
			    'no-letter (X:xpm-img-from-data xdpy xwem-time-xpm-no-letter)))

    (X-Win-put-prop win 'xwem-time-images time-images)
    (X-Win-put-prop win 'xwem-load-images load-images)
    (X-Win-put-prop win 'xwem-mail-images mail-images)

    ;; Create masks
    (setq time-masks (list 'time0 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time0) t)
			   'time1 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time1) t)
			   'time2 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time2) t)
			   'time3 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time3) t)
			   'time4 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time4) t)
			   'time5 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time5) t)
			   'time6 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time6) t)
			   'time7 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time7) t)
			   'time8 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time8) t)
			   'time9 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time9) t)
			   'time-am (X:xpm-img-from-data xdpy (eval xwem-time-xpm-am) t)
			   'time-pm (X:xpm-img-from-data xdpy (eval xwem-time-xpm-pm) t)
			   'time-dp (X:xpm-img-from-data xdpy (eval xwem-time-xpm-dp) t)))
    (setq load-masks (list 'load00 (X:xpm-img-from-data xdpy xwem-time-xpm-load00 t)
			   'load05 (X:xpm-img-from-data xdpy xwem-time-xpm-load05 t)
			   'load10 (X:xpm-img-from-data xdpy xwem-time-xpm-load10 t)
			   'load15 (X:xpm-img-from-data xdpy xwem-time-xpm-load15 t)
			   'load20 (X:xpm-img-from-data xdpy xwem-time-xpm-load20 t)
			   'load25 (X:xpm-img-from-data xdpy xwem-time-xpm-load25 t)
			   'load30 (X:xpm-img-from-data xdpy xwem-time-xpm-load30 t)))
    (setq mail-masks (list 'letter (X:xpm-img-from-data xdpy xwem-time-xpm-letter t)
			   'no-letter (X:xpm-img-from-data xdpy xwem-time-xpm-no-letter t)))

    (X-Win-put-prop win 'xwem-time-masks time-masks)
    (X-Win-put-prop win 'xwem-load-masks load-masks)
    (X-Win-put-prop win 'xwem-mail-masks mail-masks)
    
    (setq mask-pix (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
				  win 1 88 15))
    (setq xwem-time-mask-gc (XCreateGC xdpy mask-pix
				       (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
						  :function X-GXCopy
                                                  :graphics-exposures X-False
						  :foreground 1.0
						  :background 0.0)))
    (X-Win-put-prop win 'mask-pixmap mask-pix)
    (xwem-time-clear-mask win)

    ;; Now create pixmaps
    (let (depth gc mgc time-pix load-pix mail-pix)
      (setq depth (XDefaultDepth xdpy))

      (setq xwem-time-gc (XCreateGC xdpy win
				    (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
                                               :graphics-exposures X-False
					       :function X-GXCopy)))
      (setq gc xwem-time-gc)
      (setq mgc xwem-time-mask-gc)
      ;; Time
      (setq time-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win depth 107 13)
			   (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win 1 107 13)))
      (XImagePut xdpy gc (car time-pix)	0 0 (xwem-time-get-time-image win 'time0))
      (XImagePut xdpy gc (car time-pix)	9 0 (xwem-time-get-time-image win 'time1))
      (XImagePut xdpy gc (car time-pix)	18 0 (xwem-time-get-time-image win 'time2))
      (XImagePut xdpy gc (car time-pix)	27 0 (xwem-time-get-time-image win 'time3))
      (XImagePut xdpy gc (car time-pix)	36 0 (xwem-time-get-time-image win 'time4))
      (XImagePut xdpy gc (car time-pix)	45 0 (xwem-time-get-time-image win 'time5))
      (XImagePut xdpy gc (car time-pix)	54 0 (xwem-time-get-time-image win 'time6))
      (XImagePut xdpy gc (car time-pix)	63 0 (xwem-time-get-time-image win 'time7))
      (XImagePut xdpy gc (car time-pix)	72 0 (xwem-time-get-time-image win 'time8))
      (XImagePut xdpy gc (car time-pix)	81 0 (xwem-time-get-time-image win 'time9))
      (XImagePut xdpy gc (car time-pix)	90 0 (xwem-time-get-time-image win 'time-dp))
      (XImagePut xdpy gc (car time-pix)	99 0 (xwem-time-get-time-image win 'time-am)) ; 4 pixels width
      (XImagePut xdpy gc (car time-pix)	103 0 (xwem-time-get-time-image win 'time-pm)) ; 4 pixels width

      (XImagePut xdpy mgc (cdr time-pix) 0 0 (xwem-time-get-time-mask win 'time0))
      (XImagePut xdpy mgc (cdr time-pix) 9 0 (xwem-time-get-time-mask win 'time1))
      (XImagePut xdpy mgc (cdr time-pix) 18 0 (xwem-time-get-time-mask win 'time2))
      (XImagePut xdpy mgc (cdr time-pix) 27 0 (xwem-time-get-time-mask win 'time3))
      (XImagePut xdpy mgc (cdr time-pix) 36 0 (xwem-time-get-time-mask win 'time4))
      (XImagePut xdpy mgc (cdr time-pix) 45 0 (xwem-time-get-time-mask win 'time5))
      (XImagePut xdpy mgc (cdr time-pix) 54 0 (xwem-time-get-time-mask win 'time6))
      (XImagePut xdpy mgc (cdr time-pix) 63 0 (xwem-time-get-time-mask win 'time7))
      (XImagePut xdpy mgc (cdr time-pix) 72 0 (xwem-time-get-time-mask win 'time8))
      (XImagePut xdpy mgc (cdr time-pix) 81 0 (xwem-time-get-time-mask win 'time9))
      (XImagePut xdpy mgc (cdr time-pix) 90 0 (xwem-time-get-time-mask win 'time-dp))
      (XImagePut xdpy mgc (cdr time-pix) 99 0 (xwem-time-get-time-mask win 'time-am)) ; 4 pixels width
      (XImagePut xdpy mgc (cdr time-pix) 103 0 (xwem-time-get-time-mask win 'time-pm)) ; 4 pixels width
      (X-Win-put-prop win 'time-pixmap time-pix)

      ;; Load
      (setq load-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win depth 70 13)
			   (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win 1 70 13)))
      (XImagePut xdpy gc (car load-pix)	0 0 (xwem-time-get-load-image win 'load00))
      (XImagePut xdpy gc (car load-pix)	10 0 (xwem-time-get-load-image win 'load05))
      (XImagePut xdpy gc (car load-pix)	20 0 (xwem-time-get-load-image win 'load10))
      (XImagePut xdpy gc (car load-pix)	30 0 (xwem-time-get-load-image win 'load15))
      (XImagePut xdpy gc (car load-pix)	40 0 (xwem-time-get-load-image win 'load20))
      (XImagePut xdpy gc (car load-pix)	50 0 (xwem-time-get-load-image win 'load25))
      (XImagePut xdpy gc (car load-pix)	60 0 (xwem-time-get-load-image win 'load30))

      (XImagePut xdpy mgc (cdr load-pix)	0 0 (xwem-time-get-load-mask win 'load00))
      (XImagePut xdpy mgc (cdr load-pix)	10 0 (xwem-time-get-load-mask win 'load05))
      (XImagePut xdpy mgc (cdr load-pix)	20 0 (xwem-time-get-load-mask win 'load10))
      (XImagePut xdpy mgc (cdr load-pix)	30 0 (xwem-time-get-load-mask win 'load15))
      (XImagePut xdpy mgc (cdr load-pix)	40 0 (xwem-time-get-load-mask win 'load20))
      (XImagePut xdpy mgc (cdr load-pix)	50 0 (xwem-time-get-load-mask win 'load25))
      (XImagePut xdpy mgc (cdr load-pix)	60 0 (xwem-time-get-load-mask win 'load30))
      (X-Win-put-prop win 'load-pixmap load-pix)

      ;; Mail
      (setq mail-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win depth 36 13)
			   (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
					  win 1 36 13)))
      (XImagePut xdpy gc (car mail-pix) 0 0 (xwem-time-get-mail-image win 'letter))
      (XImagePut xdpy gc (car mail-pix) 18 0 (xwem-time-get-mail-image win 'no-letter))

      (XImagePut xdpy mgc (cdr mail-pix) 0 0 (xwem-time-get-mail-mask win 'letter))
      (XImagePut xdpy mgc (cdr mail-pix) 18 0 (xwem-time-get-mail-mask win 'no-letter))
      (X-Win-put-prop win 'mail-pixmap mail-pix)

      )
    
    win))

;; Offsets calculators
(defsubst xwem-time-time-offset (num)
  (* num 9))
(defsubst xwem-time-timeam-offset ()
  (* 10 9))
(defsubst xwem-time-timepm-offset ()
  (+ (* 10 9) 4))

(defsubst xwem-time-load-offset (load)
  (truncate (* load 20)))

(defsubst xwem-time-mail-offset (letter-p)
  (if letter-p 0 18))

;; Showers
(defun xwem-time-show (win x y type x-off y-off width height)
  (let ((pixmap (X-Win-get-prop win type))
	(mask-pixmap (X-Win-get-prop win 'mask-pixmap)))

    (let* ((xdpy (X-Pixmap-dpy mask-pixmap)))
      (XSelectInput xdpy win (apply 'Xmask-or (delete XM-Exposure xwem-time-window-mask)))

      (XCopyArea xdpy (cdr pixmap) mask-pixmap xwem-time-mask-gc
		 x-off y-off width height x y)
      (X-XShapeMask xdpy win X-XShape-Bounding X-XShapeSet 0 0 mask-pixmap)
      (XCopyArea (X-Win-dpy win) (car pixmap) win xwem-time-gc
		 x-off y-off width height x y)

      (XSelectInput xdpy win (apply 'Xmask-or xwem-time-window-mask))
      )))

(defsubst xwem-time-show-time0 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 0 0 9 13))

(defsubst xwem-time-show-time1 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 9 0 9 13))

(defsubst xwem-time-show-time2 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 18 0 9 13))

(defsubst xwem-time-show-time3 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 27 0 9 13))

(defsubst xwem-time-show-time4 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 36 0 9 13))

(defsubst xwem-time-show-time5 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 45 0 9 13))

(defsubst xwem-time-show-time6 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 54 0 9 13))

(defsubst xwem-time-show-time7 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 63 0 9 13))

(defsubst xwem-time-show-time8 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 72 0 9 13))

(defsubst xwem-time-show-time9 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 81 0 9 13))

(defsubst xwem-time-show-time-dp (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 90 0 9 13))

(defsubst xwem-time-show-time-am (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 99 0 4 13))

(defsubst xwem-time-show-time-pm (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'time-pixmap 103 0 4 13))

(defsubst xwem-time-show-load-00 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 0 0 10 13))

(defsubst xwem-time-show-load-05 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 10 0 10 13))

(defsubst xwem-time-show-load-10 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 20 0 10 13))

(defsubst xwem-time-show-load-15 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 30 0 10 13))

(defsubst xwem-time-show-load-20 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 40 0 10 13))

(defsubst xwem-time-show-load-25 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 50 0 10 13))

(defsubst xwem-time-show-load-30 (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'load-pixmap 60 0 10 13))

(defsubst xwem-time-show-letter (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'mail-pixmap 00 0 18 13))

(defsubst xwem-time-show-no-letter (win x y)
  "Show 0 at WIN's X Y."
  (xwem-time-show win x y 'mail-pixmap 18 0 18 13))

(defun xwem-time-show-load (win x y load-string)
  "In WIN at X Y show load average represented by LOAD-STRING.
Return how many pixels used."
  (let ((load-number (string-to-number load-string))
	(alist (list (cons "00" 0.0)
		     (cons "05" (car xwem-time-load-list))
		     (cons "10" (cadr xwem-time-load-list))
		     (cons "15" (caddr xwem-time-load-list))
		     (cons "20" (cadddr xwem-time-load-list))
		     (cons "25" (cadr (cdddr xwem-time-load-list)))
		     (cons "30" (caddr (cdddr xwem-time-load-list)))
		     (cons "100000" 100000)))
	elem load-elem)
    (while (>= load-number (cdr (setq elem (pop alist))))
      (setq load-elem elem))
    (funcall (intern-soft (concat "xwem-time-show-load-" (car load-elem))) win x y))
  10)

(defun xwem-time-show-time (win x y time-string)
  "In WIN at X Y show time represented by TIME-STRING.
Return how may pixels used."
  (let ((off 0)
	el)
    (while (> (length time-string) 0)
      (setq el (substring time-string 0 1))
      (cond ((string= el ":")
	     (xwem-time-show-time-dp win (+ x off) y)
	     (setq off (+ off 9)))
	    ((string= el "a")
	     (xwem-time-show-time-am win (+ x off) y)
	     (setq off (+ off 4)))
	    ((string= el "p")
	     (xwem-time-show-time-pm win (+ x off) y)
	     (setq off (+ off 4)))
	    ((string= el " ")
	     (setq off (+ off 9)))
	    (t (funcall (intern-soft (concat "xwem-time-show-time" el)) win (+ x off) y)
	       (setq off (+ off 9))))
      (setq time-string (substring time-string 1)))
    off))

(defun xwem-time-show-mail (win x y mail)
  "In WIN at X Y show current mail status.
Return how many pixels used."
  (if mail
      (xwem-time-show-letter win x y)
    (xwem-time-show-no-letter win x y))
  18)

(defun xwem-time-win-update (win)
  "Show current time at X Y."
  (let* ((now (current-time))
	 (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536))
	 (time (substring (current-time-string now) 11 16))
         (load (condition-case ()
                   (if (zerop (car (load-average))) ""
                     (let ((str (format " %03d" (car (load-average)))))
                       (concat (substring str 0 -2) "." (substring str -2))))
                 (error "")))
         (mail-spool-file (or display-time-mail-file
                              (getenv "MAIL")
                              (concat rmail-spool-directory
                                      (user-login-name))))
	 (mail (and (stringp mail-spool-file)
		    (or (null display-time-server-down-time)
			;; If have been down for 20 min, try again.
			(> (- (+ (nth 1 now) nowhigh)
			      display-time-server-down-time)
			   1200))
		    (let ((start-time (current-time)))
		      (prog1
			  (display-time-file-nonempty-p mail-spool-file)
			(setq now (current-time)
			      nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536))
			(if (> (- (+ (nth 1 now) nowhigh)
				  (+ (nth 1 start-time)
				     (* (- (nth 0 start-time) (* (/ (nth 0 start-time) 10) 10)) 65536)))
			       20)
			    ;; Record that mail file is not accessible.
			    (setq display-time-server-down-time 
				  (+ (nth 1 now) nowhigh))
			  ;; Record that mail file is accessible.
			  (setq display-time-server-down-time nil))))))
	 off)

    (X-Dpy-send-excursion (X-Win-dpy win)
      (xwem-time-clear-mask win)
      (setq off (+ 5 (xwem-time-show-time win 0 0 time)))
      (setq off (+ off 5 (xwem-time-show-load win off 0 load)))
      (xwem-time-show-mail win off 0 mail))
    ))

(defun xwem-time-event-handler (xdpy win xev)
  "On display XDPY and window WIN handle event XEV."
  (X-Event-CASE xev
    (:X-Expose
     (xwem-time-win-update win))

    (:X-DestroyNotify
     (xwem-message 'info "xwem-time: destroy-notify")
     (delete-itimer "xwem-time"))

    (:X-ButtonPress
     (xwem-message 'info "xwem-time: ButtonPress"))
    (:X-ButtonRelease
     (xwem-message 'info "xwem-time: ButtonRelease"))

    ))

;;;###autoload
(defun xwem-time (&optional dpyname-or-dpy)
  "Start xwem time window in system tray.
DPYNAME-OR-DPY specifies already opened X display or display name or
can be ommited."
  (let ((xdpy (or (and (X-Dpy-p dpyname-or-dpy) dpyname-or-dpy) ; X-Dpy
                  (and (not dpyname-or-dpy) (xwem-dpy)) ; nil
                  (XOpenDisplay (or dpyname-or-dpy (getenv "DISPLAY")))))) ; dpyname
    (unless (X-Dpy-p xdpy)
      (error "Can't open display"))

    (setq xwem-time-window
	  (xwem-time-init xdpy))

    (unless (X-Win-p xwem-time-window)
      (error "Can't create xwem time window"))

    (XSelectInput xdpy xwem-time-window (apply 'Xmask-or xwem-time-window-mask))
    (X-Win-EventHandler-add xwem-time-window 'xwem-time-event-handler nil
			    (list X-Expose X-ButtonPress X-ButtonRelease
				  X-DestroyNotify))
 
    (XTrayInit xdpy xwem-time-window)
    
    (start-itimer "xwem-time" 'xwem-time-win-update
		  xwem-time-interval xwem-time-interval nil t xwem-time-window)
    t))


(provide 'xwem-time)

;;; xwem-time.el ends here
