Source

xwem / lisp / xwem-rooter.el

Full commit
;;; xwem-rooter.el --- OnRoot clients support.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Sat Feb 21 03:41:02 MSK 2004
;; Keywords: 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:

;; 

;;; Code:

(require 'xwem-load)
(require 'xwem-manage)
(require 'xwem-focus)

;;; Customisation
(defgroup xwem-rooter nil
  "Group to customize rooter apps."
  :prefix "xwem-rooter-"
  :group 'xwem-modes)

(defcustom xwem-rooter-auto-raised-regexp "^$"
  "Regexp for autoraised rooters."
  :type 'string
  :group 'xwem-rooter)

;;; Internal variables

(defvar xwem-rooter-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (xwem-kbd "C-<button1>") 'xwem-client-imove)
    (define-key map (xwem-kbd "C-<button3>") 'xwem-client-iresize)
    (define-key map (xwem-kbd "C-<button2>") 'xwem-client-idestroy)
    (define-key map (xwem-kbd "C-Sh-<button1>") 'xwem-rooter-raise)
    (define-key map (xwem-kbd "C-Sh-<button3>") 'xwem-rooter-lower)
    map)
  "Keymap for rooter clients.")

(defvar xwem-rooter-mode-hook nil
  "*Hooks to call when client enters rooter mode.
Called with one argument - client.")

;;;###autoload(autoload 'xwem-rooter-raise "xwem-rooter" nil t)
(define-xwem-command xwem-rooter-raise ()
  "Raise rooter window."
  (xwem-interactive "_")

  (XRaiseWindow (xwem-dpy) (xwem-cl-xwin xwem-event-client)))

;;;###autoload(autoload 'xwem-rooter-lower "xwem-rooter" nil t)
(define-xwem-command xwem-rooter-lower ()
  "Lower rooter window."
  (xwem-interactive "_")

  (XLowerWindow (xwem-dpy) (xwem-cl-xwin xwem-event-client)))


;;;; Manage methods

;;;###autoload
(defun xwem-manage-rooter (cl)
  "Manage rooter client CL."
  (let ((xdpy (xwem-dpy))
        (xwin (xwem-cl-xwin cl))
        (xgeom (xwem-cl-xgeom cl)))

    (xwem-client-set-property cl 'noselect t) ; rooted clients can't be selected
    (xwem-client-set-property cl 'nokeyecho t) ; no keyboard echoing
    (xwem-focus-mode-set cl nil)        ; no focus mode

    (XReparentWindow xdpy xwin (xwem-rootwin)
                     (X-Geom-x xgeom) (X-Geom-y xgeom))
    (XLowerWindow xdpy xwin)
    (XMapWindow xdpy xwin)

    ;; Install client local keymap
    (xwem-use-local-map xwem-rooter-mode-map cl)

    ;; Finnaly run hook
    (run-hook-with-args 'xwem-rooter-mode-hook cl)))

(defun xwem-activate-rooter (cl &optional type)
  "Activate method for rooter clients."
  (when (eq type 'select)
    (error 'xwem-error "Trying to select rooted client!!!"))

  (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)))

(defun xwem-deactivate-rooter (cl &optional type)
  "Deactivate method for rooter clients."
  (when (eq type 'deselect)
    (error 'xwem-error "Trying to deselect rooted client!!!"))

  (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl)))


(provide 'xwem-rooter)

;;;; On-load actions
;; Rooter manage type 
(define-xwem-manage-model rooter
  "Managing model to show client on root window."
  :manage-method 'xwem-manage-rooter
  :activate-method 'xwem-activate-rooter
  :deactivate-method 'xwem-deactivate-rooter)

;;; xwem-rooter.el ends here