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

   1 ;;; xwem-transient.el --- Transient for clients support.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Sat Jun  5 01:33:25 MSD 2004
   8 ;; Keywords: xwem
   9 ;; X-CVS: $Id: xwem-transient.el,v 1.6 2005-04-04 19:54:16 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 ;;
  33
  34 ;;; Code:
  35 \f
  36 (require 'xwem-load)
  37 (require 'xwem-focus)
  38 (require 'xwem-manage)
  39
  40 ;;; Customisation
  41 (defgroup xwem-transient nil
  42   "Group to customize transient clients support."
  43   :prefix "xwem-transient-"
  44   :group 'xwem-cl)
  45
  46 (defcustom xwem-transient-client-properties
  47   '(x-border-width 2 x-border-color "blue4")
  48   "*Client properties to use when managing transient clients."
  49   :type 'list
  50   :group 'xwem-transient)
  51
  52 (defcustom xwem-transient-switch-back t
  53   "*Non-nil mean when transient client dies, switch to client who created it."
  54   :type 'boolean
  55   :group 'xwem-transient)
  56
  57 ;;; Internal variables
  58
  59 (defvar xwem-transient-keymap
  60   (let ((map (make-sparse-keymap)))
  61     (define-key map (xwem-kbd "C-<button1>") 'xwem-client-imove)
  62     (define-key map (xwem-kbd "C-<button2>") 'xwem-client-idestroy)
  63     (define-key map (xwem-kbd "C-<button3>") 'xwem-client-iresize)
  64     map)
  65   "Local keymap for transient-for clients.")
  66
  67 (define-xwem-deffered xwem-transient-on-select-cl (&optional cl)
  68   "CL just selected, check if it has transient-for windows.
  69 If so, popup them."
  70   (unless cl
  71     (setq cl (xwem-cl-selected)))
  72
  73   (when (xwem-cl-p cl)
  74     (let ((trfcls (xwem-cl-list-sort-by-recency (xwem-cl-translist cl))))
  75       (while trfcls
  76         (when (eq (xwem-cl-state (car trfcls)) 'active)
  77           (xwem-select-client (car trfcls))
  78           (setq trfcls nil))
  79         (setq trfcls (cdr trfcls)))
  80       )))
  81
  82 ;;;; ---- Transient for manage methods ----
  83
  84 ;; NOTE: Uses default refit
  85 (defun xwem-cl-transient-for-p (cl)
  86   "Return non-nil if CL is transient for client."
  87   (xwem-hints-wm-transient-for (xwem-cl-hints cl)))
  88
  89 (defun xwem-manage-transient-for (cl)
  90   "Manage CL that have transient-for flag."
  91   ;; Map window for witch CL is transient and just map and raise CL
  92   ;; over it
  93   (let ((xwin (xwem-cl-xwin cl))
  94         (trc (xwem-xwin-cl (xwem-cl-transient-for cl))))
  95
  96     ;; Apply properties specific to transient-for clients
  97     (xwem-cl-apply-plist cl xwem-transient-client-properties)
  98
  99     ;; XXX make root window be parent
 100     (XReparentWindow (xwem-dpy) xwin (xwem-rootwin)
 101                      (X-Geom-x (xwem-cl-xgeom cl))
 102                      (X-Geom-y (xwem-cl-xgeom cl)))
 103
 104     (when (xwem-cl-p trc)
 105       (setf (xwem-cl-translist trc)
 106             (cons cl (xwem-cl-translist trc)))
 107       ;; And inherit always on top rank
 108       (xwem-misc-set-xwin-always-on-top
 109        (xwem-cl-xwin cl) (xwem-xwin-rank (xwem-cl-xwin trc))))
 110
 111     ;; Install transient local keymap
 112     (xwem-use-local-map xwem-transient-keymap cl)
 113
 114     ;; Select it if needed
 115     (when (or (null trc)
 116               (xwem-cl-selected-p trc))
 117       (xwem-select-client cl))))
 118
 119 (define-xwem-deffered xwem-transient-apply-state (cl)
 120   "Apply CL's state to life."
 121   (cond ((eq (xwem-cl-state cl) 'active)
 122          (xwem-misc-raise-xwin (xwem-cl-xwin cl))
 123          (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))
 124
 125         ((eq (xwem-cl-state cl) 'inactive)
 126          (xwem-misc-lower-xwin (xwem-cl-xwin cl)))
 127         ((eq (xwem-cl-state cl) 'iconified)
 128          (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)))))
 129
 130 (defun xwem-activate-transient-for (cl &optional type)
 131   "Activate method for transient-for client CL."
 132   (cond ((eq type 'select)
 133          (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl))))
 134            (when (xwem-cl-p trc)
 135              (xwem-activate trc)))
 136          (xwem-deffered-funcall 'xwem-misc-raise-xwin (xwem-cl-xwin cl)))
 137
 138         ((eq type 'activate)
 139          (xwem-transient-apply-state cl)
 140          (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl))))
 141            (when (and (xwem-cl-p trc)
 142                       (xwem-cl-selected-p trc))
 143              (xwem-select-client cl))))
 144          ))
 145
 146 (defun xwem-deactivate-transient-for (cl &optional type)
 147   "Deactivate method for transient-for client CL."
 148   (cond ((eq type 'deactivate)
 149          (xwem-transient-apply-state cl))))
 150
 151 (defun xwem-iconify-transient-for (cl &optional type)
 152   "Iconify method for transient-for client CL."
 153   (xwem-transient-apply-state cl))
 154
 155 (defun xwem-withdraw-transient-for (cl)
 156   "Withdraw method for transient-for CL."
 157   (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl))))
 158     (when (and (xwem-cl-selected-p cl)
 159                (xwem-cl-p trc) (xwem-cl-active-p trc))
 160       (xwem-select-client trc))))
 161
 162 ;;; Additional methods
 163 (define-xwem-method on-kill transient-for (cl)
 164   "On-kill method for transient-for clients."
 165   (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl))))
 166     (when (xwem-cl-p trc)
 167       (setf (xwem-cl-translist trc)
 168             (delq cl (xwem-cl-translist trc)))
 169
 170       (when (and (xwem-cl-selected-p cl)
 171                  (xwem-cl-active-p trc))
 172         (xwem-select-client trc)))))
 173
 174 \f
 175 (provide 'xwem-transient)
 176
 177 ;;; On-load actions
 178 (define-xwem-manage-model transient-for
 179   "Manage models for clients with TRANSIENT_FOR property."
 180   :match-spec '(function xwem-cl-transient-for-p)
 181
 182   :manage-properties '(override-manage-list t)
 183   :manage-method 'xwem-manage-transient-for
 184   :activate-method 'xwem-activate-transient-for
 185   :deactivate-method 'xwem-deactivate-transient-for
 186   :iconify-method 'xwem-iconify-transient-for
 187   :withdraw-method 'xwem-withdraw-transient-for)
 188
 189 (add-hook 'xwem-client-select-hook 'xwem-transient-on-select-cl)
 190
 191 ;;; xwem-transient.el ends here