cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-battery.el

   1 ;;; xwem-battery.el --- Dockapp APM battery monitor for XWEM.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Thu Sep  2 01:14:36 GMT 2004
   8 ;; Keywords: xwem
   9 ;; X-CVS: $Id: xwem-battery.el,v 1.4 2009-10-02 12:03:35 aidan Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary:
  31
  32 ;; APM battery status monitor dockapp for use under XWEM.
  33
  34 ;; It looks like:
  35
  36 ;;   normal    charching
  37 ;;
  38 ;;    ****        ****
  39 ;;  ********    *******/
  40 ;;  *      *    *     //
  41 ;;  *      *    *    //*
  42 ;;  *      *    *   // *
  43 ;;  ********    ***//***
  44 ;;  *------*    *-//---*
  45 ;;  *------*    *//----*
  46 ;;  *------*    //-----*
  47 ;;   ******      ******
  48
  49 ;; To start using it, just add:
  50
  51 ;;   (load-module <path-to-apm-battery-ell>)
  52 ;;   (add-hook 'xwem-after-init-hook 'xwem-battery)
  53
  54 ;; to your xwemrc.el.
  55
  56 ;;; Code:
  57 \f
  58 (eval-when-compile
  59   (require 'cl)
  60   (autoload 'apm-battery "battery.ell" "Return current battery status."))
  61
  62 (require 'xlib-xlib)
  63 (require 'xlib-xshape)
  64
  65 (require 'xwem-load)
  66
  67 ;;; Customisation
  68 (defgroup xwem-batt nil
  69   "Group to customise APM battery monitor."
  70   :prefix "xwem-batt-"
  71   :group 'xwem)
  72
  73 (defcustom xwem-batt-update-interval 5
  74   "*Apm battery dockapp update interval in seconds."
  75   :type 'number
  76   :group 'xwem-batt)
  77
  78 (defcustom xwem-batt-height 24
  79   "*Height of apm battery dockapp in pixels."
  80   :type 'number
  81   :group 'xwem-batt)
  82
  83 (defcustom xwem-batt-width 10
  84   "*Width of apm battery dockapp in pixels."
  85   :type 'number
  86   :group 'xwem-batt)
  87
  88 (defcustom xwem-batt-percentage-colors
  89   '((20 . "red3")
  90     (30 . "red2")
  91     (50 . "orange")
  92     (60 . "yellow2")
  93     (70 . "yellow3")
  94     (80 . "green3")
  95     (100 . "green2"))
  96   "*Table to translate percentage to color."
  97   :type '(repeat (cons (number :tag "Percents")
  98                        (color :tag "Color")))
  99   :group 'xwem-batt)
 100
 101 (defcustom xwem-batt-ac-line-width 4
 102   "*Width of ac-line."
 103   :type 'number
 104   :group 'xwem-batt)
 105
 106 (defcustom xwem-batt-ac-line-color "blue"
 107   "*Color used to display ac-line."
 108   :type 'color
 109   :group 'xwem-batt)
 110
 111 ;;; Internal variables
 112
 113 \f
 114 (defmacro xwem-batt-itimer (win)
 115   `(X-Win-get-prop ,win 'xwem-batt-itimer))
 116 (defsetf xwem-batt-itimer (win) (itimer)
 117   `(X-Win-put-prop ,win 'xwem-batt-itimer ,itimer))
 118 (defmacro xwem-batt-xmask (win)
 119   `(X-Win-get-prop ,win 'xwem-batt-xmask))
 120 (defsetf xwem-batt-xmask (win) (xmask)
 121   `(X-Win-put-prop ,win 'xwem-batt-xmask ,xmask))
 122 (defmacro xwem-batt-pixmap (win)
 123   `(X-Win-get-prop ,win 'xwem-batt-pixmap))
 124 (defsetf xwem-batt-pixmap (win) (pixmap)
 125   `(X-Win-put-prop ,win 'xwem-batt-pixmap ,pixmap))
 126
 127 (defmacro xwem-batt-old-ac-line-p (win)
 128   `(X-Win-get-prop ,win 'old-ac-line-p))
 129 (defsetf xwem-batt-old-ac-line-p (win) (oalp)
 130   `(X-Win-put-prop ,win 'old-ac-line-p ,oalp))
 131 (defmacro xwem-batt-old-dheight (win)
 132   `(X-Win-get-prop ,win 'old-dheight))
 133 (defsetf xwem-batt-old-dheight (win) (dheight)
 134   `(X-Win-put-prop ,win 'old-dheight ,dheight))
 135
 136 (defun xwem-batt-init (xdpy)
 137   "On display XDPY create and return APM battery monitor window."
 138   (let (xwin xmask xpix)
 139     (setq xwin (XCreateWindow xdpy (XDefaultRootWindow xdpy)
 140                               0 0 xwem-batt-width xwem-batt-height 0
 141                               nil nil nil
 142                               (make-X-Attr :backing-store X-WhenMapped
 143                                            :override-redirect t)))
 144
 145     ;; Create mask pixmap for xwin
 146     (setq xmask (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy
 147                                                    :id (X-Dpy-get-id xdpy))
 148                                xwin 1 xwem-batt-width xwem-batt-height))
 149     ;; XXX Draw mask
 150     (XFillRectangle xdpy xmask xwem-misc-mask-bgc
 151                     0 0 xwem-batt-width xwem-batt-height)
 152     (XFillRectangle xdpy xmask xwem-misc-mask-fgc
 153                     0 2 xwem-batt-width (- xwem-batt-height 3))
 154     (XDrawSegments xdpy xmask xwem-misc-mask-fgc
 155                    (list (cons (cons 3 0) (cons (- xwem-batt-width 4) 0))
 156                          (cons (cons 1 1) (cons (- xwem-batt-width 2) 1))
 157                          (cons (cons 1 (- xwem-batt-height 1))
 158                                (cons (- xwem-batt-width 2)
 159                                      (- xwem-batt-height 1)))))
 160
 161     ;; Set mask
 162     (X-XShapeMask xdpy xwin X-XShape-Bounding X-XShapeSet 0 0 xmask)
 163     (setf (xwem-batt-xmask xwin) xmask)
 164
 165     ;; Create pixmap for storer
 166     (setq xpix (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy
 167                                                   :id (X-Dpy-get-id xdpy))
 168                               xwin (XDefaultDepth xdpy)
 169                               xwem-batt-width xwem-batt-height))
 170     (setf (xwem-batt-pixmap xwin) xpix)
 171     (xwem-batt-win-update xwin t)
 172
 173     xwin))
 174
 175 (defface xwem-batt-tmp-face
 176   `((t (:foreground "black")))
 177   "Temporary face used by apm battery dockapp.")
 178
 179 (define-xwem-deffered xwem-batt-apply-pixmap (xwin)
 180   "Apply pixmap storer to XWIN."
 181   (XCopyArea (X-Win-dpy xwin) (xwem-batt-pixmap xwin) xwin
 182              (XDefaultGC (X-Win-dpy xwin))
 183              0 0 xwem-batt-width xwem-batt-height 0 0))
 184
 185 (defun xwem-batt-win-update (xwin &optional force)
 186   "Update contents of XWIN to reflect current APM battery state."
 187   (let* ((xdpy (X-Win-dpy xwin))
 188          (xpix (xwem-batt-pixmap xwin))
 189          (as (apm-battery))
 190          (ac-line-p (car as))
 191          (cperc (caddr as))
 192          (perc-cols xwem-batt-percentage-colors)
 193          dheight)
 194
 195     (when (> cperc 100)
 196       (setq  cperc 100))
 197
 198     ;; Calculate displayed height
 199     (setq dheight (round (/ (* cperc (- xwem-batt-height 5)) 100.0)))
 200
 201     (when (or force (not (eq dheight (xwem-batt-old-dheight xwin)))
 202               (not (eq ac-line-p (xwem-batt-old-ac-line-p xwin))))
 203       (XFillRectangle xdpy xpix (XDefaultGC xdpy)
 204                       0 0 xwem-batt-width xwem-batt-height)
 205       ;; Outline battery
 206       (XFillRectangle xdpy xpix (XDefaultGC xdpy)
 207                       0 0 xwem-batt-width xwem-batt-height)
 208       (XDrawRectangle xdpy xpix (xwem-face-get-gc 'xwem-face-black)
 209                       1 2 (- xwem-batt-width 3) (- xwem-batt-height 4))
 210       (XDrawLine xdpy xpix (xwem-face-get-gc 'xwem-face-black)
 211                  3 1 (- xwem-batt-width 4) 1)
 212       (setq force t))
 213
 214     ;; Maybe redraw percentage
 215     (when (or force (not (eq dheight (xwem-batt-old-dheight xwin))))
 216       ;; Find appopriate color
 217       (while (and perc-cols (> cperc (caar perc-cols)))
 218         (setq perc-cols (cdr perc-cols)))
 219       (setq perc-cols (cdar perc-cols))
 220
 221       (xwem-set-face-foreground 'xwem-batt-tmp-face perc-cols)
 222       (XFillRectangle xdpy xpix (xwem-face-get-gc 'xwem-batt-tmp-face)
 223                       2 (- xwem-batt-height 2 dheight)
 224                       (- xwem-batt-width 4) dheight)
 225       (when (< dheight (- xwem-batt-height 5))
 226         (XDrawLine xdpy xpix (xwem-face-get-gc 'xwem-face-black)
 227                    2 (- xwem-batt-height 2 dheight)
 228                    (- xwem-batt-width 2) (- xwem-batt-height 2 dheight)))
 229
 230       ;; Save DHEIGHT
 231       (setf (xwem-batt-old-dheight xwin) dheight))
 232
 233     ;; Maybe redraw ac-line status
 234     (when (or force (not (eq ac-line-p (xwem-batt-old-ac-line-p xwin))))
 235       (when ac-line-p
 236         (xwem-set-face-foreground 'xwem-batt-tmp-face xwem-batt-ac-line-color)
 237         (let ((acgc (xwem-face-get-gc 'xwem-batt-tmp-face)))
 238           (setf (X-Gc-line-width acgc) xwem-batt-ac-line-width)
 239           (XChangeGC xdpy acgc)
 240           (XDrawLine xdpy xpix acgc
 241                      xwem-batt-width xwem-batt-ac-line-width
 242                      0 (- xwem-batt-height xwem-batt-ac-line-width))
 243           (setf (X-Gc-line-width acgc) 0)
 244           (XChangeGC xdpy acgc)))
 245       (setf (xwem-batt-old-ac-line-p xwin) ac-line-p))
 246
 247     (xwem-batt-apply-pixmap xwin)))
 248
 249 (defun xwem-batt-win-remove (xwin &optional need-destroy)
 250   "Remove battery dockapp."
 251   (when (xwem-batt-itimer xwin)
 252     (delete-itimer (xwem-batt-itimer xwin)))
 253   (XFreePixmap (X-Win-dpy xwin) (xwem-batt-xmask xwin))
 254   (XFreePixmap (X-Win-dpy xwin) (xwem-batt-pixmap xwin))
 255
 256   (setf (xwem-batt-itimer xwin) nil
 257         (xwem-batt-xmask xwin) nil
 258         (xwem-batt-pixmap xwin) nil
 259         (xwem-batt-old-dheight xwin) nil
 260         (xwem-batt-old-ac-line-p xwin) nil)
 261
 262   ;; Remove events handler
 263   (X-Win-EventHandler-rem xwin 'xwem-batt-event-handler)
 264
 265   (when need-destroy
 266     (XDestroyWindow (xwem-dpy) xwin)))
 267
 268 (defvar xwem-battery-keymap
 269   (let ((map (make-sparse-keymap)))
 270     (define-key map [button1] 'xwem-battery-status)
 271     (define-key map [button3] 'xwem-battery-popup-menu)
 272     map)
 273   "*Keymap for battery dock.")
 274
 275 (defvar xwem-battery-keymap
 276   (let ((map (make-sparse-keymap)))
 277     (define-key map [button1] 'xwem-battery-status)
 278     (define-key map [button3] 'xwem-battery-popup-menu)
 279     map)
 280   "*Keymap for battery dock.")
 281
 282 (defun xwem-batt-event-handler (xdpy win xev)
 283   "Event handler for xwem battery monitor."
 284   (X-Event-CASE xev
 285     (:X-MapNotify (xwem-batt-win-update win t))
 286     (:X-Expose (xwem-batt-apply-pixmap win))
 287     (:X-DestroyNotify (xwem-batt-win-remove win))
 288     (:X-ButtonPress
 289      (xwem-overriding-local-map xwem-battery-keymap
 290        (xwem-dispatch-command-xevent xev)))))
 291
 292 ;;;###autoload
 293 (defun xwem-battery (&optional dockip dockgroup dockalign)
 294   "Start xwem apm battery monitor in system tray."
 295   (interactive)
 296   (unless (fboundp 'apm-battery)
 297     (error "APM Battery module not loaded"))
 298
 299   (let ((bxwin (xwem-batt-init (xwem-dpy))))
 300     ;; Enable turbo mode
 301     (when xwem-misc-turbo-mode
 302       (XSetWindowBackgroundPixmap (xwem-dpy) bxwin (xwem-batt-pixmap bxwin)))
 303
 304     (XSelectInput (xwem-dpy) bxwin
 305                   (Xmask-or XM-Exposure XM-StructureNotify
 306                             XM-ButtonPress XM-ButtonRelease))
 307     (X-Win-EventHandler-add bxwin 'xwem-batt-event-handler nil
 308                             (list X-Expose X-DestroyNotify
 309                                   X-ButtonPress X-ButtonRelease))
 310
 311     (xwem-XTrayInit (xwem-dpy) bxwin dockip dockgroup dockalign)
 312
 313     (setf (xwem-batt-itimer bxwin)
 314           (start-itimer "xwem-batt"
 315                         `(lambda () (xwem-batt-win-update ,bxwin))
 316                         xwem-batt-update-interval
 317                         xwem-batt-update-interval))
 318     'started))
 319
 320 ;;;###autoload(autoload 'xwem-battery-status "xwem-battery" nil t)
 321 (define-xwem-command xwem-battery-status ()
 322   "Show battery status in xwem minibuffer."
 323   (xwem-interactive)
 324   (destructuring-bind
 325       (ac-line status perc)
 326       (or (apm-battery) '(nil nil nil))
 327     (xwem-message
 328      'info "APM Battery: AC-line: %s, Status: %S, Percentage: %d%%"
 329      (if ac-line "on" "off") status perc)))
 330
 331 ;;;###autoload(autoload 'xwem-battery-popup-menu "xwem-battery" nil t)
 332 (define-xwem-command xwem-battery-popup-menu (ev)
 333   "Popup battery menu."
 334   (xwem-interactive (list xwem-last-event))
 335   (unless (button-event-p ev)
 336     (error 'xwem-error
 337            "`xwem-battery-popup-menu' must be bound to mouse event"))
 338   (xwem-popup-menu
 339    (list "Battery"
 340          ["Status" xwem-battery-status]
 341          "---"
 342          (vector "Destroy"
 343                  `(xwem-batt-win-remove
 344                    ,(X-Event-win xwem-last-xevent) t)))))
 345
 346 ;;;; In case there is no battery.ell
 347 (unless (fboundp 'apm-battery)
 348   (defvar apm-program "apm")
 349   (defvar apm-state-percent-arguments "-bl")
 350   (defvar apm-status-alist
 351     '((0 . high) (1 . low) (2 . critical) (3 . charging)))
 352
 353   (defun apm-battery ()
 354     "Return battery status."
 355     (let (state percents)
 356       (with-temp-buffer
 357         (call-process apm-program nil (current-buffer)
 358                       nil apm-state-percent-arguments)
 359         (goto-char (point-min))
 360         (setq state (cdr (assq (string-to-int
 361                                 (buffer-substring (point-at-bol)
 362                                                   (point-at-eol)))
 363                                apm-status-alist)))
 364         (forward-line)
 365         (setq percents (string-to-int
 366                         (buffer-substring (point-at-bol)
 367                                           (point-at-eol)))))
 368       (list (eq state 'charging) state percents))))
 369
 370 \f
 371 (provide 'xwem-battery)
 372
 373 ;;; xwem-battery.el ends here