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

   1 ;;; xwem-osd.el --- On Screen Display implementation for XWEM.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Mon Jan 12 13:14:32 MSK 2004
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-osd.el,v 1.7 2005-04-04 19:54:14 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; Support for on screen display in XWEM.  xwem-osd can display text,
  32 ;; processing bar, other stuff using shaped window.  The main feature
  33 ;; of this OSD implementation that it uses OSD instances to display
  34 ;; stuff, so it does not need to handle expose events.
  35
  36 ;; OSD supports system tray.  It is very easy to write OSD dockapp.
  37 ;; Simple example in xwem-framei.el.  You just create osd as usuall,
  38 ;; but using `xwem-osd-create-dock', where you can specify width,
  39 ;; height and keymap to use, for example:
  40 ;;
  41 ;;    (setq myosd (xwem-osd-create-dock (xwem-dpy) 24 24 (list 'keymap myosd-keymap)))
  42 ;;    (xwem-osd-text myosd "test")
  43 ;;
  44 ;; This will create dockapp in system tray, display "test" in it, and
  45 ;; will execute commands in `myosd-keymap' if you click on OSD.  To
  46 ;; define commands in `myosd-keymap' do something like:
  47 ;;
  48 ;;    (define-key myosd-keymap [button1]
  49 ;;      (lambda () (interactive) (xwem-message 'info "Myosd Hello world!")))
  50 ;;    (define-key myosd-keymap [button3] 'myosd-popup-menu)
  51 ;;
  52
  53 ;; New instance type added - dots.  To poly dataset in OSD you can use
  54 ;; `xwem-osd-dots-add' function.  TYPE is one of:
  55 ;;
  56 ;;    'points      - Little circles.
  57 ;;    'lines       - Lines
  58 ;;    'linespoints - Lines with points at ends.
  59 ;;    'impulses    - Impulses from 0 to dot's Y.
  60 ;;    'dots        - Tiny dots.
  61 ;;    'steps       - Steps around points
  62 ;;    'fsteps      - Another 'steps variant
  63 ;;    'histeps     - Yet another 'steps variant (NI)
  64 ;;    'boxes       - Boxes arount points (NI)
  65 ;;
  66 ;; For example if you have some dataset(CPU load f.i.) which
  67 ;; represented in as list of cons cells, which car is X and cdr is Y.
  68 ;;
  69 ;;   ds
  70 ;;   ==>
  71 ;;   ((1 . 3) (3 . 6) (5 . 4) (7 . 10) (9 . 10) (11 . 3))
  72 ;;
  73 ;;   (xwem-osd-dots-add myosd ds 'impulses "red4")
  74 ;;
  75 ;; This will draw nice graph.
  76 ;;
  77 ;; For full drawing posibilities consider `xwem-diagram.el'.
  78
  79 ;;; Code:
  80 \f
  81 (eval-when-compile
  82   (require 'cl))
  83
  84 (require 'xlib-xshape)
  85 (require 'xlib-tray)
  86 (require 'xlib-xpm)
  87
  88 (require 'xwem-diagram)
  89
  90 (defgroup xwem-osd nil
  91   "Group to customize OSD."
  92   :prefix "xwem-osd-"
  93   :group 'xwem-misc)
  94
  95 (defcustom xwem-osd-default-font "fixed"
  96   "Default font for text drawed in osd."
  97   :type 'string
  98   :group 'xwem-osd)
  99
 100 (defcustom xwem-osd-default-color "black"
 101   "Default color used to draw."
 102   :type 'color
 103   :group 'xwem-osd)
 104
 105 (defcustom xwem-osd-default-stack-rank 100
 106   "Default rank."
 107   :type 'number
 108   :group 'xwem-osd)
 109
 110 ;;; Internal variables
 111
 112 (defconst xwem-osd-instance-types '(text line dots arc rect icon)
 113   "List of valid types of osd instance.")
 114
 115 \f
 116 (defstruct xwem-osd-instance
 117   type                                  ; instance type, see `xwem-osd-instance-types'
 118   osd                                   ; back reference to osd
 119   (depth 0)                             ; depth
 120
 121   xwin xmask
 122   color                                 ; instance background color
 123
 124   plist)                                ; User defined plist
 125
 126 (defsubst xwem-osd-instance-put-prop (osin prop val)
 127   "In OSD's instance OSIN properties list put property PROP with value VAL."
 128   (setf (xwem-osd-instance-plist osin)
 129         (plist-put (xwem-osd-instance-plist osin) prop val)))
 130 (put 'xwem-osd-instance-put-prop 'lisp-indent-function 2)
 131
 132 (defsubst xwem-osd-instance-get-prop (osin prop)
 133   "Return OSD's instance OSIN property PROP."
 134   (plist-get (xwem-osd-instance-plist osin) prop))
 135
 136 (defsubst xwem-osd-instance-rem-prop (osin prop)
 137   "Remove OSD's instance OSIN property PROP."
 138   (setf (xwem-osd-instance-plist osin)
 139         (plist-remprop (xwem-osd-instance-plist osin) prop)))
 140
 141 (defmacro xwem-osd-instance-xdpy (osin)
 142   "Return display of OSIN osd instance."
 143   `(xwem-osd-xdpy (xwem-osd-instance-osd osin)))
 144
 145 (defstruct xwem-osd
 146   state                                 ; 'destroyed, 'hided or 'shown
 147   x y width height
 148
 149   xdpy
 150   xwin
 151   xmask
 152
 153   gc                                    ; GC used to draw
 154   mask-gc                               ; GC used to draw mask
 155
 156   instances                             ; list of xwem-osd-instance structs sorted by depth
 157
 158   plist)                                ; User defined plist
 159
 160 (defsubst xwem-osd-put-prop (osd prop val)
 161   "In OSD's properties list put property PROP with value VAL."
 162   (setf (xwem-osd-plist osd)
 163         (plist-put (xwem-osd-plist osd) prop val)))
 164 (put 'xwem-osd-put-prop 'lisp-indent-function 2)
 165
 166 (defsubst xwem-osd-get-prop (osd prop)
 167   "Return OSD's property PROP."
 168   (plist-get (xwem-osd-plist osd) prop))
 169
 170 (defsubst xwem-osd-rem-prop (osd prop)
 171   "Remove OSD's property PROP."
 172   (setf (xwem-osd-plist osd)
 173         (plist-remprop (xwem-osd-plist osd) prop)))
 174
 175 (defmacro xwem-osd-xwin-copy (osd)
 176   `(xwem-osd-get-prop ,osd 'xwin-copy))
 177 (defsetf xwem-osd-xwin-copy (osd) (xwin)
 178   `(xwem-osd-put-prop ,osd 'xwin-copy ,xwin))
 179
 180 \f
 181 ;;; Functions
 182 (defun xwem-osd-event-handler (xdpy xwin xev)
 183   "On X display XDPY and window XWIN handle X Event XEV."
 184   (let* ((osd (xwem-osd-get-osd xwin))
 185          (keymap (xwem-osd-get-prop osd 'keymap)))
 186     (when (xwem-osd-p osd)
 187       (X-Event-CASE xev
 188         (:X-DestroyNotify
 189          (xwem-osd-destroy osd t))
 190
 191         ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
 192          (when (keymapp keymap)
 193            (xwem-overriding-local-map keymap
 194              (xwem-dispatch-command-xevent xev)))))
 195       )))
 196
 197 ;;; Instances operations
 198 (defun xwem-osd-instance-destroy (osin)
 199   "Destroy osd instance OSIN."
 200   (let ((xdpy (xwem-osd-instance-xdpy osin)))
 201     (XDestroyWindow xdpy (xwem-osd-instance-xwin osin))
 202     (XFreeColors xdpy (XDefaultColormap xdpy)
 203                  (list (xwem-osd-instance-color osin)) nil)
 204     (XFreePixmap xdpy (xwem-osd-instance-xmask osin))
 205
 206     (X-invalidate-cl-struct osin)))
 207
 208 (defun xwem-osd-add-instance (osd depth &optional color)
 209   "In OSD add osd instance with background COLOR.
 210 Return newly created osd instance."
 211   (unless depth
 212     (setq depth 0))
 213   (unless color
 214     (setq color
 215           (or (X-Color-name (X-Gc-foreground (xwem-osd-gc osd)))
 216               xwem-osd-default-color)))
 217
 218   (let* ((xdpy (xwem-osd-xdpy osd))
 219          (osin (make-xwem-osd-instance
 220                 :osd osd :depth depth
 221                 :color (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 222                                          color))))
 223     (setf (xwem-osd-instance-xwin osin)
 224           (XCreateWindow xdpy (xwem-osd-xwin osd)
 225                          0 0 (xwem-osd-width osd) (xwem-osd-height osd)
 226                          0 nil nil nil
 227                          (make-X-Attr :override-redirect t
 228                                       :background-pixel (xwem-osd-instance-color osin))))
 229     (setf (xwem-osd-instance-xmask osin)
 230           (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
 231                          (xwem-osd-instance-xwin osin) 1
 232                          (xwem-osd-width osd) (xwem-osd-height osd)))
 233     (xwem-osd-instance-clear osin)
 234
 235     (push osin (xwem-osd-instances osd))
 236
 237     ;; - Sort instances according to depth
 238     ;; - Install below sibling
 239     (setf (xwem-osd-instances osd)
 240           (sort (xwem-osd-instances osd)
 241                 (lambda (s1 s2)
 242                   (< (xwem-osd-instance-depth s1) (xwem-osd-instance-depth s2)))))
 243
 244     (let ((siblings (xwem-osd-instances osd))
 245           below-sibl)
 246       (while siblings
 247         (if (>= (xwem-osd-instance-depth (car siblings)) depth)
 248             (setq siblings nil)
 249           (setq below-sibl (car siblings)))
 250         (setq siblings (cdr siblings)))
 251
 252       (when below-sibl
 253         (XConfigureWindow xdpy (xwem-osd-instance-xwin osin)
 254                           (make-X-Conf :sibling (xwem-osd-instance-xwin below-sibl)
 255                                        :stackmode X-Below))))
 256     osin))
 257
 258 (defun xwem-osd-instance-clear (osin)
 259   "Clear mask area of OSD instance."
 260   (let ((osd (xwem-osd-instance-osd osin)))
 261     (xwem-osd-mask-fgbg osd)
 262     (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 263                     0 0 (xwem-osd-width osd) (xwem-osd-height osd))
 264     (xwem-osd-mask-fgbg osd)))
 265
 266 (defun xwem-osd-instance-show (osin)
 267   "Show osd instance OSIN."
 268   (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin)))
 269
 270 (defun xwem-osd-instance-set-color (osin new-color)
 271   "Set new color."
 272   (let ((xdpy (xwem-osd-instance-xdpy osin)))
 273     (XFreeColors xdpy (XDefaultColormap xdpy)
 274                  (list (xwem-osd-instance-color osin)) nil)
 275     (setf (xwem-osd-instance-color osin)
 276           (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 277                             new-color))
 278     (XSetWindowBackground xdpy (xwem-osd-instance-xwin osin)
 279                           (xwem-osd-instance-color osin))
 280     (XClearArea xdpy (xwem-osd-instance-xwin osin)
 281                 0 0 (xwem-osd-width (xwem-osd-instance-osd osin))
 282                 (xwem-osd-height (xwem-osd-instance-osd osin)) nil)))
 283
 284 ;;; OSD functions
 285 ;;;###autoload
 286 (defun xwem-osd-create (xdpy x y width height &optional x-parent properties)
 287   "On X display XDPY create new xwem osd context with +X+Y/WIDTHxHEIGHT geometry on X-PARENT.
 288 PROPERTIES is a plist for osd.  Supported properties are:
 289
 290  'keymap     - Keymap for OSD.
 291  'stack-rank - Rank of OSD in windows stack."
 292   (let ((osd (make-xwem-osd :xdpy xdpy
 293                             :x x :y y :width width :height height
 294                             :plist properties))
 295         (keymap (plist-get properties 'keymap))
 296         (stack-rank (plist-get properties 'stack-rank)))
 297     (setf (xwem-osd-xwin osd)
 298           (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy))
 299                          x y width height 0 nil nil nil
 300                          (make-X-Attr :override-redirect t
 301                                       :background-pixel (XBlackPixel xdpy)
 302                                       :event-mask (Xmask-or XM-StructureNotify
 303                                                             (if keymap
 304                                                                 (Xmask-or XM-KeyPress
 305                                                                           XM-ButtonPress
 306                                                                           XM-ButtonRelease)
 307                                                               0)))))
 308     ;; Apply STACK-RANK
 309     (when stack-rank
 310       (xwem-misc-set-xwin-always-on-top (xwem-osd-xwin osd) stack-rank))
 311
 312     ;; Create gc
 313     (setf (xwem-osd-gc osd)
 314           (XCreateGC xdpy (xwem-osd-xwin osd)
 315                      (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
 316                                 :foreground (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 317                                                               xwem-osd-default-color)
 318                                 :font (X-Font-get xdpy xwem-osd-default-font))))
 319
 320     (X-Win-put-prop (xwem-osd-xwin osd) 'osd-ctx osd)
 321     (X-Win-EventHandler-add-new (xwem-osd-xwin osd) 'xwem-osd-event-handler)
 322
 323     (xwem-osd-create-mask osd)
 324     osd))
 325
 326 ;;;###autoload
 327 (defun xwem-osd-create-dock (xdpy width height &optional properties)
 328   "Create docked osd instance.
 329 XDPY - Display.
 330 X, Y, WIDTH, HEIGHT - OSD Geometry."
 331   (let ((osd (xwem-osd-create xdpy 0 0 width height nil properties)))
 332     (xwem-osd-clear osd)
 333     (xwem-XTrayInit xdpy (xwem-osd-xwin osd))
 334     osd))
 335
 336 (defun xwem-osd-get-osd (xwin)
 337   "Get osd context associated with XWIN."
 338   (and (X-Win-p xwin) (X-Win-get-prop xwin 'osd-ctx)))
 339
 340 (defun xwem-osd-mask-fgbg (osd)
 341   "Exchange foreground and background colors in OSD's mask gc."
 342   (let* ((mgc (xwem-osd-mask-gc osd))
 343          (fg (X-Gc-foreground mgc))
 344          (bg (X-Gc-background mgc)))
 345     (setf (X-Gc-foreground mgc) bg)
 346     (setf (X-Gc-background mgc) fg)
 347
 348     (XChangeGC (xwem-osd-xdpy osd) mgc)))
 349
 350 (defun xwem-osd-clear-mask (osd)
 351   "Clear mask area of OSD context."
 352   (xwem-osd-mask-fgbg osd)
 353   (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 354                   0 0 (xwem-osd-width osd) (xwem-osd-height osd))
 355   (xwem-osd-mask-fgbg osd))
 356
 357 (defun xwem-osd-create-mask (osd)
 358   "For xwem osd context OSD create mask pixmap."
 359   (let ((xdpy (xwem-osd-xdpy osd)))
 360     (setf (xwem-osd-xmask osd)
 361           (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
 362                          (xwem-osd-xwin osd) 1 (xwem-osd-width osd)
 363                          (xwem-osd-height osd)))
 364     (unless (xwem-osd-mask-gc osd)
 365       (setf (xwem-osd-mask-gc osd)
 366             (XCreateGC xdpy (xwem-osd-xmask osd)
 367                        (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
 368                                   :foreground 1.0
 369                                   :background 0.0
 370                                   :font (X-Font-get xdpy xwem-osd-default-font)))))
 371     (xwem-osd-clear-mask osd)))
 372
 373 (defun xwem-osd-set-height (osd new-height)
 374   "Set OSD's window height to NEW-HEIGHT."
 375   (setf (xwem-osd-height osd) new-height)
 376   (XResizeWindow (xwem-osd-xdpy osd)
 377                  (xwem-osd-xwin osd)
 378                  (xwem-osd-width osd)
 379                  (xwem-osd-height osd))
 380
 381   (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
 382   (xwem-osd-create-mask osd))
 383
 384 (defun xwem-osd-set-width (osd new-width)
 385   "Set OSD's window width to NEW-WIDTH."
 386   (setf (xwem-osd-width osd) new-width)
 387   (XResizeWindow (xwem-osd-xdpy osd)
 388                  (xwem-osd-xwin osd)
 389                  (xwem-osd-width osd)
 390                  (xwem-osd-height osd))
 391
 392   (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
 393   (xwem-osd-create-mask osd))
 394
 395 (defun xwem-osd-move (osd new-x new-y)
 396   "Change OSD's window position to NEW-X, NEW-Y."
 397   (XMoveWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
 398                new-x new-y))
 399
 400 (defun xwem-osd-set-xwin-color (osd color-name)
 401   "Set background for OSD's window to COLOR-NAME."
 402   (let ((xdpy (xwem-osd-xdpy osd)))
 403     (XSetWindowBackground xdpy (xwem-osd-xwin osd)
 404                           (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 405                                             color-name))))
 406
 407 (defun xwem-osd-set-gc-color (osd color-name)
 408   "Set OSD's gc foreground color to COLOR-NAME."
 409   (let ((xdpy (xwem-osd-xdpy osd)))
 410     (setf (X-Gc-foreground (xwem-osd-gc osd))
 411           (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 412                             color-name))
 413     (XChangeGC xdpy (xwem-osd-gc osd))))
 414
 415 (defun xwem-osd-set-color (osd color-name)
 416   "Set both OSD's background and OSD's gc foreground color to COLOR-NAME."
 417   (let* ((xdpy (xwem-osd-xdpy osd))
 418          (col (XAllocNamedColor xdpy (XDefaultColormap xdpy)
 419                                 color-name)))
 420     (XSetWindowBackground xdpy (xwem-osd-xwin osd) col)
 421     (xwem-osd-clear-xwin osd)
 422     (setf (X-Gc-foreground (xwem-osd-gc osd)) col)
 423     (XChangeGC xdpy (xwem-osd-gc osd))))
 424
 425 (defun xwem-osd-show (osd)
 426   "Show OSD's window."
 427   (xwem-osd-apply-xmask-1 osd)
 428   (XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))
 429   (xwem-misc-raise-xwin (xwem-osd-xwin osd))
 430
 431   (setf (xwem-osd-state osd) 'shown))
 432
 433 (defun xwem-osd-hide (osd)
 434   "Hide OSD's window."
 435   (XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))
 436
 437   (setf (xwem-osd-state osd) 'hidden))
 438
 439 (defun xwem-osd-destroy-instances (osd)
 440   "Destroy all instances in OSD."
 441   (mapc 'xwem-osd-instance-destroy (xwem-osd-instances osd))
 442   (setf (xwem-osd-instances osd) nil))
 443
 444 (defun xwem-osd-destroy (osd &optional already-destroyed)
 445   "Destroy OSD context."
 446   (xwem-osd-destroy-instances osd)
 447
 448   (X-Win-EventHandler-rem (xwem-osd-xwin osd) 'xwem-osd-event-handler)
 449   (X-Win-rem-prop (xwem-osd-xwin osd) 'osd-ctx)
 450
 451   (unless already-destroyed
 452     (XDestroyWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)))
 453   (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))
 454   (XFreeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd))
 455   (XFreeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd))
 456
 457   (X-invalidate-cl-struct osd))
 458
 459 (defun xwem-osd-set-font (osd font-name)
 460   "In OSD's context set font to be FONT-NAME."
 461   (let* ((xdpy (xwem-osd-xdpy osd))
 462          (gc (xwem-osd-gc osd))
 463          (mgc (xwem-osd-mask-gc osd))
 464          (font (X-Font-get xdpy font-name)))
 465     (setf (X-Gc-font mgc) font)
 466     (XChangeGC xdpy mgc)
 467
 468     (setf (X-Gc-font gc) font)
 469     (XChangeGC xdpy gc)))
 470
 471 (defun xwem-osd-char-width (osd)
 472   "Return width of OSD's window in characters."
 473   ;; XXX assumes that font is width fixed
 474   (/ (xwem-osd-width osd)
 475      (X-Text-width (xwem-osd-xdpy osd) (X-Gc-font (xwem-osd-mask-gc osd)) "_")))
 476
 477 (defun xwem-osd-clear-xwin (osd)
 478   "Clear contents of OSD's window."
 479   (XClearArea (xwem-osd-xdpy osd) (xwem-osd-xwin osd) 0 0
 480               (xwem-osd-width osd) (xwem-osd-height osd) nil))
 481
 482 (defun xwem-osd-clear (osd)
 483   "Clear OSD window."
 484   (xwem-osd-destroy-instances osd)
 485   (xwem-osd-clear-mask osd)
 486   (xwem-osd-apply-xmask osd))
 487
 488 (define-xwem-deffered xwem-osd-apply-xmask (osd)
 489   "Apply OSD's mask to life."
 490   (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
 491                 X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)))
 492
 493 (defun xwem-osd-text (osd string)
 494   "In OSD's context show STRING.
 495 If OSD has any instances, they will be destroyed."
 496   (let* ((xdpy (xwem-osd-xdpy osd))
 497          (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)
 498                   (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string))))
 499
 500     (xwem-osd-destroy-instances osd)
 501     ;; Update window shape
 502     (xwem-osd-clear-mask osd)
 503     (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 504                  0 yoff string)
 505     (xwem-osd-apply-xmask osd)))
 506
 507 (defun xwem-osd-color-text (osd strspec-list)
 508   "In OSD's win draw colored text specified by STRSPEC-LIST."
 509   (xwem-osd-clear osd)
 510   (let ((curstr ""))
 511     (mapcar (lambda (strspec)
 512               (let* ((xdpy (xwem-osd-xdpy osd))
 513                      (str (concat curstr (car strspec)))
 514                      (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str)
 515                               (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str))))
 516                 (xwem-osd-set-xwin-color osd (cdr strspec))
 517                 (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 518                              0 yoff str)
 519                 (xwem-osd-apply-xmask osd)
 520
 521                 (setq curstr (concat curstr (car strspec)))))
 522             strspec-list)))
 523
 524 (defun xwem-osd-text-add (osd x y string &optional depth color)
 525   "In OSD's context at X Y coordinates add STRING colored with COLOR."
 526   (let* ((xdpy (xwem-osd-xdpy osd))
 527          (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)
 528                   (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)))
 529          osin)
 530
 531     ;; Setup OSD instance
 532     (setq osin (xwem-osd-add-instance osd depth color))
 533     (setf (xwem-osd-instance-type osin) 'text)
 534     (XDrawString xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 535                  x (+ y yoff) string)
 536     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 537                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 538     (xwem-osd-instance-show osin)
 539
 540     ;; Update window shape
 541     (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 542                  x (+ y yoff) string)
 543     (xwem-osd-apply-xmask osd)
 544     osin))
 545
 546 (defun xwem-osd-set-line-width (osd new-line-width)
 547   "Set OSD's gc line width to NEW-LINE-WIDTH."
 548   (setf (X-Gc-line-width (xwem-osd-gc osd)) new-line-width)
 549   (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd))
 550
 551   (setf (X-Gc-line-width (xwem-osd-mask-gc osd)) new-line-width)
 552   (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd))
 553   )
 554
 555 (defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional depth color)
 556   "In OSD's window add line."
 557   (let ((xdpy (xwem-osd-xdpy osd))
 558         osin)
 559
 560     ;; Create OSD line instance
 561     (setq osin (xwem-osd-add-instance osd depth color))
 562     (setf (xwem-osd-instance-type osin) 'line)
 563     (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 564                x0 y0 x1 y1)
 565     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 566                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 567     (xwem-osd-instance-show osin)
 568
 569     ;; Update OSD window shape
 570     (XDrawLine xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 571                x0 y0 x1 y1)
 572     (xwem-osd-apply-xmask osd)
 573     osin))
 574
 575 (defun xwem-osd-dots-add (osd dots type &optional depth color)
 576   "In OSD's window add DOTS of TYPE."
 577   (let ((xdpy (xwem-osd-xdpy osd))
 578         osin)
 579
 580     ;; Create OSD dots instancne
 581     (setq osin (xwem-osd-add-instance osd depth color))
 582     (setf (xwem-osd-instance-type osin) 'dots)
 583     (xwem-diag-plot-dots type (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 584                          0 (xwem-osd-height osd) dots)
 585     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 586                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 587     (xwem-osd-instance-show osin)
 588
 589     ;; Update OSD window shape
 590     (xwem-diag-plot-dots type (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 591                          0 (xwem-osd-height osd) dots)
 592     (xwem-osd-apply-xmask osd)
 593     osin))
 594
 595 (defun xwem-osd-arc-add (osd xarc &optional depth color)
 596   "In OSD's window draw arc specified by XARC."
 597   (let ((xdpy (xwem-osd-xdpy osd))
 598         osin)
 599
 600     ;; Create OSD arc instance
 601     (setq osin (xwem-osd-add-instance osd depth color))
 602     (setf (xwem-osd-instance-type osin) 'arc)
 603     (XDrawArcs xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 604                (list xarc))
 605     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 606                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 607     (xwem-osd-instance-show osin)
 608
 609     ;; Update OSD shape
 610     (XDrawArcs xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 611                (list xarc))
 612     (xwem-osd-apply-xmask osd)
 613     osin))
 614
 615 (defun xwem-osd-rect-add (osd x y width height &optional depth color fill-p)
 616   "In OSD's window add rectangle specified by X Y WIDTH and HEIGHT.
 617 If FILL-P is non-nil, rectangle will be filled instead of outdrawing."
 618   (let ((xdpy (xwem-osd-xdpy osd))
 619         osin)
 620
 621     ;; Created OSD rect instance
 622     (setq osin (xwem-osd-add-instance osd depth color))
 623     (setf (xwem-osd-instance-type osin) 'rect)
 624     (XDrawRectangles xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
 625                      (list (make-X-Rect :x x :y y :width width :height height))
 626                      fill-p)
 627     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 628                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 629     (xwem-osd-instance-show osin)
 630
 631     ;; Update OSD shape
 632     (XDrawRectangles xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
 633                      (list (make-X-Rect :x x :y y :width width :height height))
 634                      fill-p)
 635     (xwem-osd-apply-xmask osd)
 636     osin))
 637
 638 (defun xwem-osd-icon-data-add (osd xpm-data &optional x y depth)
 639   "In OSD's window add icon.
 640 X and Y specifies osd instance location inside OSD(default is 0 0).
 641 DEPTH specifies osd instance depth(default is 0).
 642 XPM-DATA string of xpm image."
 643   (unless depth
 644     (setq depth 0))
 645   (unless x
 646     (setq x 0))
 647   (unless y
 648     (setq y 0))
 649
 650   (let ((xdpy (xwem-osd-xdpy osd))
 651         osin xpix xpix-mask)
 652
 653     ;; Created OSD icon instance
 654     (setq osin (xwem-osd-add-instance osd depth))
 655     (setf (xwem-osd-instance-type osin) 'icon)
 656
 657     (setq xpix (X:xpm-pixmap-from-data
 658                 xdpy (xwem-osd-instance-xwin osin) xpm-data)
 659           xpix-mask (X:xpm-pixmap-from-data
 660                      xdpy (xwem-osd-instance-xwin osin) xpm-data t))
 661
 662     (XCopyArea xdpy xpix-mask (xwem-osd-instance-xmask osin)
 663                xwem-misc-mask-bgc 0 0
 664                (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
 665                x y)
 666     (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
 667                   X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin))
 668     (XCopyArea xdpy xpix-mask (xwem-osd-xmask osd)
 669                xwem-misc-mask-bgc 0 0
 670                (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
 671                x y)
 672     (xwem-osd-apply-xmask osd)
 673
 674     (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-osd-instance-xwin osin) xpix)
 675
 676     (xwem-osd-instance-show osin)
 677     osin))
 678
 679 (defun xwem-osd-icon-file-add (osd xpm-file &optional x y depth)
 680   "Same as `xwem-osd-icon-data-add', but takes xpm image from FILE."
 681   (let (xpm-data)
 682     (with-temp-buffer
 683       (insert-file-contents-literally xpm-file)
 684       (setq xpm-data (buffer-substring)))
 685
 686   (xwem-osd-icon-data-add osd xpm-data x y depth)))
 687
 688 (defun xwem-osd-offscreen (osd)
 689   "Put OSD off the screen, displaying OSD copy.
 690 Usefull to prevent flicking."
 691   (if (xwem-osd-xwin-copy osd)
 692       (XResizeWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)
 693                      (xwem-osd-width osd) (xwem-osd-height osd))
 694     (setf (xwem-osd-xwin-copy osd)
 695           (XCreateWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
 696                          0 0
 697                          (xwem-osd-width osd) (xwem-osd-height osd)
 698                          0
 699                          nil nil nil (make-X-Attr :override-redirect t))))
 700
 701   (XCopyArea (xwem-osd-xdpy osd)
 702              (xwem-osd-xwin osd) (xwem-osd-xwin-copy osd)
 703              (xwem-osd-gc osd)
 704              0 0 (xwem-osd-width osd) (xwem-osd-height osd)
 705              0 0)
 706   (XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)))
 707
 708 (defun xwem-osd-commit (osd)
 709   "Commit changes made while OSD was in off screen."
 710   (XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin-copy osd)))
 711
 712 ;;; You might consider more powerfull `working' package, which is part
 713 ;;; of CEDET.
 714 (defun xwem-osd-working-bar-display (tot-len percents)
 715   "Return a string with a bar-graph end percentile showing percentage.
 716 TOT-LEN is the total length of bar.  PERCENTS is percentage state."
 717   (let* ((prstr (int-to-string percents))
 718          (len (- tot-len (+ 10 (length prstr))))
 719          (dcs (truncate (* len (/ percents 100.0))))
 720          (tlen (- len dcs)))
 721     (concat ": ["
 722             (make-string (if (> dcs 0) dcs 0) ?#)
 723             (make-string (if (> tlen 0) tlen 0) ?.)
 724             "] ... " prstr "%")))
 725
 726 (defun xwem-osd-working-percent-bar (osd prompt percents)
 727   "Display percentage with PERCENTS done bar prompting PROMPT."
 728   (require 'working)
 729
 730   (let ((osdcw (xwem-osd-char-width osd)))
 731     (xwem-osd-text osd (concat prompt (xwem-osd-working-bar-display (- osdcw (length prompt)) percents)))))
 732
 733
 734 ;;; Testing:
 735 ;;  (setq mosd (xwem-osd-create (xwem-dpy) 10 20 400 200))
 736 ;;  (xwem-osd-set-color mosd "green4")
 737 ;;  (xwem-osd-set-font mosd "10x20")
 738 ;;  (xwem-osd-text mosd "test")
 739 ;;  (xwem-osd-show mosd)
 740
 741 ;;  (progn
 742 ;;    (setq i 0)
 743 ;;    (xwem-osd-show mosd)
 744 ;;    (xwem-osd-set-color mosd "red4")
 745 ;;    (while (< i 100)
 746 ;;      (cond ((= i 60) (xwem-osd-set-color mosd "green4"))
 747 ;;          ((= i 30) (xwem-osd-set-color mosd "yellow4")))
 748 ;;      (xwem-osd-working-percent-bar mosd "Processing" i)
 749 ;;      (sleep-for 0.01)
 750 ;;      (incf i 1))
 751 ;;    (xwem-osd-set-color mosd "red4")
 752 ;;    (xwem-osd-text mosd "Processing done."))
 753
 754 ;;  (xwem-osd-destroy mosd)
 755
 756 ;; Here is example from Steve Youngs <steve@xwem.org> to
 757 ;; display date using OSD:
 758
 759 ;; (require 'xwem-osd)
 760 ;; (defvar sy-osd-date nil)
 761 ;; (copy-face 'default 'sy-osd-date-face)
 762 ;; (set-face-foreground 'sy-osd-date-face "blanchedalmond")
 763
 764 ;; (defvar sy-osd-date-keymap
 765 ;;   (let ((map (make-sparse-keymap 'sy-osd-date-keymap)))
 766 ;;     (define-key map [button3] '(lambda () (interactive) (calendar)))
 767 ;;     map)
 768 ;;   "Keymap for date OSD.")
 769
 770 ;; (defun sy-show-date-osd ()
 771 ;;   "*Display the current date using OSD."
 772 ;;   (interactive)
 773 ;;   (let* ((face `sy-osd-date-face)
 774 ;;       (text (format-time-string "%a, %b %e"))
 775 ;;       (width (+ 3 (X-Text-width
 776 ;;                    (xwem-dpy)
 777 ;;                    (X-Font-get (xwem-dpy)
 778 ;;                                (face-font-name face))
 779 ;;                    text)))
 780 ;;       (height (+ 3 (X-Text-height
 781 ;;                     (xwem-dpy)
 782 ;;                     (X-Font-get (xwem-dpy)
 783 ;;                                 (face-font-name face))
 784 ;;                     text))))
 785 ;;     (setq sy-osd-date (xwem-osd-create-dock
 786 ;;                     (xwem-dpy)
 787 ;;                     width
 788 ;;                     height
 789 ;;                     (list 'keymap sy-osd-date-keymap)))
 790 ;;     (xwem-osd-set-color sy-osd-date (face-foreground-name face))
 791 ;;     (xwem-osd-set-font sy-osd-date (face-font-name face))
 792 ;;     (xwem-osd-text sy-osd-date text)
 793 ;;     (xwem-osd-show sy-osd-date)))
 794
 795 ;; (defun sy-update-osd-date-maybe (&optional force)
 796 ;;   "Update the OSD date at midnight.
 797
 798 ;;  Optional Argument FORCE means to update the date now."
 799 ;;   (let* ((now (decode-time))
 800 ;;       (cur-hour (nth 2 now))
 801 ;;       (cur-min (nth 1 now))
 802 ;;       (cur-comp-time (+ (* cur-hour 60) cur-min)))
 803 ;;     (when (or force (= 0 cur-comp-time))
 804 ;;       (when (xwem-osd-p sy-osd-date)
 805 ;;      (xwem-osd-text sy-osd-date (format-time-string "%a, %b %e"))))))
 806
 807 ;; (defun sy-update-osd-date ()
 808 ;;   "*Force update of the OSD date."
 809 ;;   (interactive)
 810 ;;   (when (xwem-osd-p sy-osd-date)
 811 ;;     (sy-update-osd-date-maybe t)))
 812
 813 ;; (defun sy-delete-osd-date ()
 814 ;;   "*Delete the OSD date."
 815 ;;   (interactive)
 816 ;;   (when (xwem-osd-p sy-osd-date)
 817 ;;     (when (itimerp "sy-osd-date-itimer")
 818 ;;       (delete-itimer "sy-osd-date-itimer"))
 819 ;;     (xwem-osd-destroy sy-osd-date)))
 820
 821 ;; (add-hook 'xwem-after-init-hook (lambda ()
 822 ;;                                (progn
 823 ;;                                  (sy-show-date-osd)
 824 ;;                                  (start-itimer "sy-osd-date-itimer"
 825 ;;                                                'sy-update-osd-date-maybe
 826 ;;                                                60 60))))
 827
 828
 829 \f
 830 (provide 'xwem-osd)
 831
 832 ;;; xwem-osd.el ends here