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

   1 ;;; xwem-root.el --- Root window and geom operations.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: 21 Mar 2003
   8 ;; Keywords: xlib, xwem
   9 ;; X-CVS: $Id: xwem-root.el,v 1.10 2005-04-04 19:54:15 lg 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 ;; This file used to manipulate and agragate information about root
  33 ;; window. Also has macros to work with geometry.
  34 ;;
  35
  36 ;;; TODO:
  37
  38 ;; * WM_ICON_SIZE on root window. (ICCCM 4.1.3.2)
  39
  40 ;;; Code
  41 \f
  42 (require 'xwem-load)
  43 (require 'xwem-misc)
  44
  45 ;;; Variables
  46 (defconst xwem-root-ev-mask
  47   (Xmask-or XM-SubstructureRedirect
  48             XM-KeyPress XM-ButtonPress XM-ButtonRelease)
  49   "Event mask for X root window.")
  50
  51 (defgroup xwem-root nil
  52   "Group to customize root screen."
  53   :prefix "xwem-root-"
  54   :group 'xwem)
  55
  56 (defcustom xwem-root-cursor-shape '(X-XC-left_ptr)
  57   "*Cursors shape which will be used when pointer is over root window."
  58   :type (xwem-cursor-shape-choice)
  59   :set (xwem-cus-set-cursor-shape xwem-root-cursor (xwem-rootwin))
  60   :initialize 'custom-initialize-default
  61   :group 'xwem-root)
  62
  63 (defcustom xwem-root-cursor-foreground-color "white"
  64   "*Cursor's foreground color used when pointer is over root window."
  65   :type 'color
  66   :set (xwem-cus-set-cursor-foreground xwem-root-cursor)
  67   :initialize 'custom-initialize-default
  68   :group 'xwem-root)
  69
  70 (defcustom xwem-root-cursor-background-color "black"
  71   "*Cursor's background color used when pointer is over root window."
  72   :type 'color
  73   :set (xwem-cus-set-cursor-background xwem-root-cursor)
  74   :initialize 'custom-initialize-default
  75   :group 'xwem-root)
  76
  77 (defcustom xwem-root-another-wm-mode nil
  78   "*Non-nil mean try to start even if another WM is running.
  79 EXPERIMENTAL, NOT TESTED, DOES NOT WORK, set to non-nil on your own risk."
  80   :type 'boolean
  81   :group 'xwem-root)
  82
  83 ;;; Internal variables
  84
  85 (defvar xwem-root-cursor nil
  86   "Internal variable, stores root cursor.")
  87
  88 \f
  89 ;;; Functions
  90 (defun xwem-root-install-grab ()
  91   "Called after xwem initialized."
  92   (xwem-kbd-install-grab 'xwem-root-prefix (xwem-rootwin)))
  93
  94 (defun xwem-root-install-cursor ()
  95   "Install cursor on root window."
  96   ;; Create root cursor
  97   (setq  xwem-root-cursor
  98          (xwem-make-cursor xwem-root-cursor-shape
  99                            xwem-root-cursor-foreground-color
 100                            xwem-root-cursor-background-color))
 101   (XSetWindowCursor (xwem-dpy) (xwem-rootwin) xwem-root-cursor))
 102
 103 ;;;###xwem-autoload
 104 (defvar xwem-another-wm-mode nil
 105   "Non-nil mean another wm is running.")
 106
 107 (defun xwem-init-root-xerr-hook (xdpy xerr)
 108   (if (not xwem-root-another-wm-mode)
 109       (error 'xwem-error "Another window manager running")
 110
 111     (setq xwem-another-wm-mode t)
 112     (XSelectInput (xwem-dpy) (xwem-rootwin)
 113                   (Xmask-and xwem-root-ev-mask
 114                              (lognot XM-SubstructureRedirect)))))
 115
 116 ;;;###xwem-autoload
 117 (defun xwem-init-root (host)
 118   "Initialization part for root."
 119   (setf (xwem-dpy) (XOpenDisplay host))
 120
 121   ;; Select input on root window
 122   (pushnew 'xwem-init-root-xerr-hook (X-Dpy-error-hooks (xwem-dpy)))
 123   (XSelectInput (xwem-dpy) (xwem-rootwin) xwem-root-ev-mask)
 124   (XSync (xwem-dpy))
 125   (setf (X-Dpy-error-hooks (xwem-dpy))
 126         (delq 'xwem-init-root-xerr-hook (X-Dpy-error-hooks (xwem-dpy))))
 127
 128   (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-root-events-handler 100)
 129
 130 ;  (add-hook 'xwem-after-init-hook 'xwem-root-install-grab)
 131   (add-hook 'xwem-after-init-hook 'xwem-root-install-cursor))
 132
 133 ;;;###autoload
 134 (defun xwem-fini-root ()
 135   (XSetInputFocus (xwem-dpy) X-PointerRoot X-RevertToPointerRoot)
 136   (XCloseDisplay (xwem-dpy)))
 137
 138 ;;;###autoload
 139 (defun xwem-root-refresh (x y width height)
 140   "Refresh area WIDTHxHEIGHT+X+Y.
 141 Probably will not work if backing store enabled in some window."
 142   (let ((wn (XCreateWindow
 143              (xwem-dpy) nil
 144              x y width height 0
 145              nil                        ;DefaultDepth
 146              nil                        ;CopyFromParent
 147              nil                        ;CopyFromParent
 148              (make-X-Attr :override-redirect t)
 149              )))
 150     (XMapWindow (xwem-dpy) wn)
 151     (XDestroyWindow (xwem-dpy) wn)))
 152
 153 ;;;###autoload
 154 (defun xwem-root-events-handler (xdpy xwin xev)
 155   "Events handler for root window."
 156   (xwem-debug 'xwem-root "Event: ev=%s win = %S"
 157               '(X-Event-name xev) '(X-Win-id (X-Event-win xev)))
 158
 159   (X-Event-CASE xev
 160     ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
 161      (xwem-debug 'xwem-root "KeyButton event: parent win=%S, evname=%S"
 162                  '(X-Win-id (X-Event-win xev)) '(X-Event-name xev))
 163      (xwem-overriding-local-map 'xwem-root-prefix
 164        (xwem-dispatch-command-xevent xev)))
 165
 166     (:X-MappingNotify
 167      ;; Modifiers mapping has been changed - reintialize
 168      (when (= (X-Event-xmapping-request xev) 0) ; Modifier
 169        (xwem-debug 'xwem-root "MappingNotify: reinitializing modifiers ..")
 170        (xwem-deffered-funcall 'xwem-kbd-initialize-modifiers)))
 171
 172     (:X-ConfigureRequest
 173      ;; Some of root win clients issued XConfigureWindow
 174      (xwem-ev-reconfig xdpy xwin xev))
 175
 176     (:X-MapRequest
 177      (xwem-debug 'xwem-root "MapRequest event: parent win=%S, window=%S"
 178                  '(X-Win-id (X-Event-xmaprequest-parent xev))
 179                  '(X-Win-id (X-Event-xmaprequest-window xev)))
 180      (xwem-ev-mapreq xdpy xwin xev))
 181
 182     (:X-UnmapNotify
 183      (xwem-debug 'xwem-root "UnmapNotify event: event win=%S, window=%S"
 184                  '(X-Win-id (X-Event-xunmap-event xev))
 185                  '(X-Win-id (X-Event-xunmap-window xev)))
 186      (xwem-ev-unmap xdpy xwin xev))
 187
 188     (:X-DestroyNotify
 189      (xwem-debug 'xwem-root "DestroyNotify event: parent win=%S, window=%S"
 190                  '(X-Win-id (X-Event-xdestroywindow-event xev))
 191                  '(X-Win-id (X-Event-xdestroywindow-window xev)))
 192      (xwem-ev-destroy xdpy xwin xev))
 193     ))
 194
 195 \f
 196 (provide 'xwem-root)
 197
 198 ;;; xwem-root.el ends here