Source

xwem / lisp / xwem-root.el

Full commit
;;; xwem-root.el --- Root window and geom operations.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: 21 Mar 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id$

;; 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:
;;
;; This file used to manipulate and agragate information about root
;; window. Also has macros to work with geometry.
;;
;;; Code
(require 'xlib-xlib)


;;; Variables

(defconst xwem-root-ev-mask (Xmask-or XM-SubstructureNotify XM-SubstructureRedirect
                                      XM-KeyPress XM-ButtonPress XM-ButtonRelease
				      XM-PropertyChange
				      XM-FocusChange
				      XM-EnterWindow
				      XM-ResizeRedirect)
  "Event mask for X root window.")

;;;###autoload
(defvar xwem-root-screen nil
  "Description of root screen")

(defvar xwem-root-keymap
  (let ((map (make-sparse-keymap 'XWEM-root-map)))
    (set-keymap-parents map (list xwem-global-map))
    (define-key map (xwem-kbd "<button3>") 'xwem-popup-auto-menu)
    (define-key map (xwem-kbd "<button1>") 'xwem-popup-clients-menu)
    map)
  "Root window keymap.
  
Bindings:
\\{xwem-root-map}")


;;; Functions

;;;###autoload
(defun xwem-init-root (host)
  "Initialization part for root."
  (setq xwem-root-screen (xwem-dpy-dummy))

  (aset xwem-root-screen 0 (XOpenDisplay host))

  ;; Install our guess dispatcher
  (setf (X-Dpy-parse-guess-dispatcher (xwem-dpy)) 'xwem-parse-message-guess)

  (when xwem-debug
    (setf (X-Dpy-log-buffer (xwem-dpy)) "*XWEM.Xlog*"))

  (aset xwem-root-screen 1 (XDefaultRootWindow (xwem-dpy)))
  (aset xwem-root-screen 2 (XGetGeometry (xwem-dpy) (xwem-rootwin))))

;;;###autoload
(defun xwem-fini-root ()
  (XCloseDisplay (xwem-dpy)))

;;;###autoload
(defun xwem-root-refresh (x y width height)
  "Refresh area WIDTHxHEIGHT+X+Y."
  (let ((wn (XCreateWindow
	     (xwem-dpy) nil
	     x y width height 0
	     nil                        ;DefaultDepth
	     nil                        ;CopyFromParent
	     nil                        ;CopyFromParent
	     (make-X-Attr :override-redirect 0)
	     )))
    (XMapWindow (xwem-dpy) wn)
    (XDestroyWindow (xwem-dpy) wn)))

;;; Events handling for root window
(defun xwem-root-hkeybutton (xev)
  "KeyPress, ButtonPress or ButtonRelease event XEV."
  (let ((xwem-override-global-map xwem-root-keymap))
    (xwem-kbd-handle-keybutton xev)))

(defun xwem-root-hconfigure-request (xev)
  "ConfigureRequest event XEV."
  (let* ((win (X-Event-xconfigurerequest-window xev))
	 (cl (X-Win-get-prop win 'xwem-cl))
	 (vmask (X-Event-xconfigurerequest-value-mask xev)))

    (X-Dpy-log (xwem-dpy) "ROOT: ConfigureRequest event for win=%s vmask=%s, x=%S, y=%S, width=%S, height=%S\n"
	       '(X-Win-id win) 'vmask '(X-Event-xconfigurerequest-x xev) '(X-Event-xconfigurerequest-y xev)
	       '(X-Event-xconfigurerequest-width xev) '(X-Event-xconfigurerequest-height xev))

    (if (not (xwem-cl-p cl))
	(XConfigureWindow (xwem-dpy) win
			  (make-X-Conf :dpy (X-Win-dpy win)
				       :x (when (Xtest vmask X-CWX) (X-Event-xconfigurerequest-x xev))
				       :y (when (Xtest vmask X-CWY) (X-Event-xconfigurerequest-y xev))
				       :width (when (Xtest vmask X-CWWidth)  (X-Event-xconfigurerequest-width xev))
				       :height (when (Xtest vmask X-CWHeight)  (X-Event-xconfigurerequest-height xev))
				       :border-width (when (Xtest vmask X-CWBorderWidth) (X-Event-xconfigurerequest-border-width xev))))

      ;; [else] Client window already in air
      (if (Xtest vmask (Xmask-or X-CWX X-CWY X-CWWidth X-CWHeight X-CWBorderWidth))
	  (progn
	    ;; TODO: Is this really needed?
;	    (when (Xtest vmask X-CWWidth)
;	      (setf (X-Geom-width (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-width xev)))
;	    (when (Xtest vmask X-CWHeight)
;	      (setf (X-Geom-height (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-height xev)))
;	    (when (Xtest vmask X-CWX)
;	      (setf (X-Geom-x (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-x xev)))
;	    (when (Xtest vmask X-CWY)
;	      (setf (X-Geom-y (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-y xev)))
;	    (when (Xtest vmask X-CWBorderWidth)
;	      (setf (X-Geom-border-width (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-border-width xev)))

	    (xwem-manda-refit cl))

	(xwem-cl-send-config cl)))
    nil))

(defun xwem-root-hmap-request (xev)
  "MapRequest event XEV."
  (X-Dpy-log (X-Event-dpy xev) "XWEM-ROOT-HMAP-REQUEST: parent win=%S, window=%S\n"
	     '(X-Win-id (X-Event-win xev)) '(X-Win-id (X-Event-xmaprequest-window xev)))

  (let ((cl (X-Win-get-prop (X-Event-xmaprequest-window xev) 'xwem-cl)))
    (if (xwem-cl-p cl)
	(xwem-manda-manage cl)

      (xwem-make-client (X-Event-xmaprequest-window xev) nil)))
  )

;;;###autoload
(defun xwem-root-events-handler (xdpy xwin xev)
  "Events handler for root window."
  (X-Dpy-log xdpy "ROOT WIN: ev=%s win = %S\n" '(X-Event-name xev) '(X-Win-id (X-Event-win xev)))

  (X-Event-CASE xev
    ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
     (xwem-root-hkeybutton xev))

    (:X-ConfigureRequest
     ;; Some of root win clients issued XConfigureWindow
     (xwem-root-hconfigure-request xev)
     )

    (:X-MapRequest
     (xwem-root-hmap-request xev))
    ))


(provide 'xwem-root)

;;; xwem-root.el ends here