xwem / lisp / xwem-rooter.el

;;; 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 'xlib-xwin)

(defgroup xwem-rooter nil
  "Group to customize rooter apps."
  :prefix "xwem-rooter-"
  :group 'xwem)

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

(defvar xwem-rooter-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map (xwem-kbd "C-<button1>") 'xwem-rooter-move)
    (define-key map (xwem-kbd "C-<button2>") 'xwem-rooter-destroy)
    (define-key map (xwem-kbd "C-<button3>") 'xwem-rooter-resize)
    (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.")

;;;###autoload
(defmacro xwem-rooter-add-client (name class-name &optional class-instance wm-name)
  "Define client which class name matches CLASS-NAME regexp.
And class instance matches CLASS-INS regexp, and WM_NAME matches
WM-NAME as rooter client."
  `(define-xwem-manda ,name (xwem-class-matcher ,class-name ,class-instance ,wm-name)
     0 t nil 'xwem-rooter-manage))

(define-xwem-command xwem-rooter-move ()
  "Interactively move client clicked by button event MEV."
  (xwem-interactive "_")

  (let* ((mev xwem-last-xevent)
         (xwin (X-Event-xbutton-event mev))
         (x-clic (X-Event-xbutton-event-x mev))
         (y-clic (X-Event-xbutton-event-y mev)))

    (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonMotion XM-ButtonRelease XM-ButtonPress)
                  xwem-cursor-move)
    (unwind-protect
        (let (xev done)
          (while (not done)
            (setq xev (xwem-next-event))

            (X-Event-CASE xev
              (:X-ButtonRelease
               (setq done t))

              (:X-MotionNotify
               (XMoveWindow (xwem-dpy) xwin
                            (- (X-Event-xmotion-root-x xev) x-clic)
                            (- (X-Event-xmotion-root-y xev) y-clic))))))
      
      (XUngrabPointer (xwem-dpy)))))

(define-xwem-command xwem-rooter-resize ()
  "Resize rooter client."
  (xwem-interactive "_")

  (let* ((mev xwem-last-xevent)
         (xwin (X-Event-xbutton-event mev))
         (x-clic (X-Event-xbutton-event-x mev))
         (y-clic (X-Event-xbutton-event-y mev)))

    (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonMotion XM-ButtonRelease XM-ButtonPress)
                  xwem-cursor-resize)
    (unwind-protect
        (let (done xev)
          (XResizeWindow (xwem-dpy) xwin x-clic y-clic)
          (while (not done)
            (setq xev (xwem-next-event))
            (X-Event-CASE xev
              (:X-ButtonRelease
               (setq done t))
              (:X-MotionNotify
               (let ((xoff (X-Event-xmotion-event-x xev))
                     (yoff (X-Event-xmotion-event-y xev)))
                 ;; XXX workaround INT/CARD bug
                 (xwem-message 'info "x=%d, y=%d" xoff yoff)
                 (when (and (< xoff 40000) (< yoff 40000))
                   (XResizeWindow (xwem-dpy) xwin xoff yoff))))
              )))
      (XUngrabPointer (xwem-dpy)))))

(define-xwem-command xwem-rooter-destroy ()
  "Destroy rooter client."
  (xwem-interactive "_")

  (let* ((mev xwem-last-xevent)
         (xwin (X-Event-xbutton-event mev)))

    (when (X-Win-p xwin)
      (XDestroyWindow (X-Win-dpy xwin) xwin))))
  
(define-xwem-command xwem-rooter-raise ()
  "Raise rooter window."
  (xwem-interactive "_")

  (XRaiseWindow (xwem-dpy) xwem-event-window))

(define-xwem-command xwem-rooter-lower ()
  "Lower rooter window."
  (xwem-interactive "_")

  (XLowerWindow (xwem-dpy) xwem-event-window))

(defun xwem-rooter-manage (cl &rest args)
  "Manage rooter client CL."
  (let ((xdpy (xwem-dpy))
        (xwin (xwem-cl-xwin cl))
        (xgeom (xwem-cl-xgeom cl)))

    (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-focus-excursion xwin
      (map-keymap (lambda (key bind)
                    (xwem-local-set-key key bind cl))
                  xwem-rooter-keymap))
    ))


(provide 'xwem-rooter)

;;; xwem-rooter.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.