Source

xwem / lisp / xwem-rooter.el

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

;; Copyright (C) 2004,2005 by XWEM Org.

;; 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-always-on-top-spec '((((eval t)) . 30))
  "*List of conscells in form:
\(MATCH-SPEC . RANK) for always-on-top icons.
If MATCH-SPEC matches rooticon's client - than RANK is set as always
on top rank."
  :type 'sexp
  :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 "_")
  (xwem-misc-raise-xwin (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 "_")
  (xwem-misc-lower-xwin (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))

    ;; Set apropriate always on top rank
    (let ((rank (find cl xwem-rooter-always-on-top-spec
                      :key 'car :test 'xwem-cl-match-p)))
      (when rank
        (xwem-misc-set-xwin-always-on-top xwin (cdr rank))))

    (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)))

;;;###autoload(put 'manage 'rooter 'xwem-manage-rooter)

(defun xwem-activate-rooter (cl &optional type)
  "Activate method for rooter clients."
  (when (eq type 'select)
    (error 'xwem-error "Trying to select rooted client!!!"))
  (XMapWindow (xwem-dpy) (xwem-cl-xwin cl))
  (xwem-misc-raise-xwin (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!!!"))
  (xwem-misc-lower-xwin (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