PageRenderTime 61ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/xemacs-packages-extra-20110502/xemacs-packages/xwem/lisp/xwem-battery.el

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