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

   1 ;;; xwem-focus.el --- Controling focus under XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Fri Dec 19 13:25:30 MSK 2003
   8 ;; Keywords: xwem, xlib
   9 ;; X-CVS: $Id: xwem-focus.el,v 1.10 2005-04-04 19:54:11 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 ;; Various focus operations.
  33
  34 ;;; Code:
  35 \f
  36 (require 'xwem-load)
  37
  38 ;;;###autoload
  39 (defcustom xwem-default-focus-mode 'generic
  40   "*Default CL's focus mode."
  41   :type '(choice (const :tag "Generic mode" generic)
  42                  (const :tag "Click to focus" click-focus)
  43                  (const :tag "Follow mouse" follow-mouse))
  44   :group 'xwem)
  45
  46 ;;; Internal variables
  47
  48 (defvar xwem-focus-stack nil
  49   "Last thing that has focus.
  50 Internal variable, do not modify.")
  51
  52 \f
  53 ;;;###xwem-autoload
  54 (defun xwem-focus-xcurrent ()
  55   "Return current focus."
  56   (let ((cf (XGetInputFocus (xwem-dpy))))
  57     cf))
  58
  59 (defun xwem-focus-push (&optional xwin)
  60   "Push current focus or XWIN to `xwem-focus-stack'."
  61   (push (or xwin (xwem-focus-xcurrent)) xwem-focus-stack))
  62
  63 ;;;###xwem-autoload
  64 (defun xwem-focus-pop ()
  65   "Pop value from `xwem-focus-stack'."
  66   (pop xwem-focus-stack))
  67
  68 ;;;###xwem-autoload
  69 (defun xwem-focus-push-set (xwin)
  70   "Push current focus to `xwem-focus-stack' and set focus to XWIN."
  71   (xwem-focus-push)
  72   (XSetInputFocus (xwem-dpy) xwin X-RevertToParent))
  73
  74 ;;;###xwem-autoload
  75 (defun xwem-focus-pop-set ()
  76   "Pop from `xwem-focus-stack' and set focus."
  77   (let ((xwin (xwem-focus-pop)))
  78     (when (X-Win-p xwin)
  79       (XSetInputFocus (xwem-dpy) xwin X-RevertToParent))))
  80
  81 ;;;###xwem-autoload
  82 (defun xwem-focus-set (thing &optional push revert)
  83   "Set input focus to THING.
  84 THING - one of X-Win, xwem-frame, or xwem-client.
  85 PUSH  - Non-nil for pushing thing into `xwem-focus-stack'."
  86   (cond ((X-Win-p thing) ; X11 window
  87          (when push
  88            (xwem-focus-push))
  89 ;         (if (= (X-Attr-mapstate (XGetWindowAttributes (xwem-dpy) thing)) X-Viewable)
  90              (XSetInputFocus (xwem-dpy) thing (or revert X-RevertToParent))
  91
  92            ;; XXX Set input focus to root window, because that THING
  93            ;; is not viewable yet.
  94 ;           (xwem-message 'warning "Window is not viewable ... %S" (XGetWMName (xwem-dpy) thing))
  95 ;           (xwem-focus-set (xwem-dummy-client))))
  96              )
  97
  98         ;; xwem client
  99         ((xwem-cl-p thing)
 100          ;; For Passive/Locally Active focus models
 101          (when (or (xwem-client-property thing 'ignore-has-input-p)
 102                    (eq xwem-client-focusing 'advanced)
 103                    (X-WMHints-input-p
 104                     (xwem-hints-wm-hints (xwem-cl-hints thing))))
 105            (xwem-focus-set (xwem-cl-xwin thing) push revert))
 106
 107            ;; For Locally Active/Globally Active focus models
 108            (when (XWMProtocol-set-p (xwem-dpy)
 109                    (xwem-hints-wm-protocols (xwem-cl-hints thing))
 110                    "WM_TAKE_FOCUS")
 111              (xwem-client-sendmsg-atom thing
 112                (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS")
 113                (and (X-Event-p xwem-last-xevent)
 114                     (or (and (member (X-Event-type xwem-last-xevent)
 115                                      (list X-ButtonPress X-ButtonRelease))
 116                              (X-Event-xbutton-time xwem-last-xevent))
 117                         (and (member (X-Event-type xwem-last-xevent)
 118                                      (list X-KeyPress X-KeyRelease))
 119                              (X-Event-xkey-time xwem-last-xevent)))))))
 120
 121         ;; xwem window
 122         ((xwem-win-p thing)
 123          (xwem-focus-set (xwem-win-frame thing) push revert))
 124
 125         ;; xwem-frame
 126         ((xwem-frame-p thing)
 127          (let* ((cl (xwem-win-cl (xwem-frame-selwin thing)))
 128                 ;; maybe cl is embedded frame?
 129                 (embf (and (xwem-cl-p cl)
 130                            (X-Win-get-prop (xwem-cl-xwin cl) 'xwem-frame))))
 131
 132            (if (xwem-frame-p embf)
 133                ;; embedded frame
 134                (xwem-focus-set embf push revert)
 135
 136              (if (xwem-cl-p cl)
 137                  ;; Current client active
 138                  (xwem-focus-set cl push revert)
 139                (xwem-focus-set (xwem-frame-xwin thing) push revert)))))
 140
 141         ;; Normally should not happen
 142         (t (xwem-focus-set (xwem-dummy-client)))))
 143
 144 \f
 145 ;;; Focus modes support
 146 (defvar xwem-focus-mode-names nil
 147   "List of valid focus modes.")
 148
 149 (define-xwem-client-property xwem-focus-mode nil
 150   "Client focus model."
 151   :type '(eval (list 'choice xwem-focus-mode-names))
 152   :set 'xwem-focus-set-focus-mode)
 153
 154 (defun xwem-focus-set-focus-mode (cl prop mode)
 155   "Set CL focus mode property PROP to MODE."
 156   (xwem-focus-mode-invoke cl 'before-mode-change)
 157   (xwem-cl-put-prop cl prop (or mode xwem-default-focus-mode))
 158   (xwem-focus-mode-invoke cl 'after-mode-change))
 159
 160 (defmacro define-xwem-focus-mode (name args &optional docstring &rest body)
 161   "Define new focus mode named by NAME.
 162 FUN specifies function to call when focus changes."
 163   (let ((fun (or (and (functionp args) `(function ,args))
 164                  `(lambda ,args
 165                     ,docstring
 166                     ,@body))))
 167     `(progn
 168        (put (quote ,name) 'xwem-focus-mode ,fun)
 169        (add-to-list 'xwem-focus-mode-names
 170                     (cons (list 'const :tag ,docstring (quote ,name))
 171                           (quote ,fun))))))
 172 (put 'define-xwem-focus-mode 'lisp-indent-function 'defun)
 173
 174 ;;;###xwem-autoload
 175 (defun xwem-focus-mode-invoke (cl &rest args)
 176   "Invoke CL's focus mode function with ARGS.
 177 Invoke focus mode, car of ARGS normally type of invocation.
 178 Built-in invocation types are:
 179
 180   'before-mode-change   - Called before focus mode changed.
 181   'after-mode-change    - Called after focus mode has been changed.
 182   'focus-in             - When CL receives focus.
 183   'focus-out            - When CL looses focus.
 184   'enter                - When CL enters.
 185   'leave                - When CL leaves.
 186   'before-keymap-change - Before CL's local map changed.
 187   'after-keymap-change  - After CL's local map changed.
 188 "
 189   (when (xwem-cl-p cl)
 190     (let* ((mode (xwem-client-property cl 'xwem-focus-mode))
 191            (fun (get mode 'xwem-focus-mode)))
 192       (when fun
 193         (apply fun cl args)))))
 194
 195 ;;;###xwem-autoload
 196 (defun xwem-focus-mode-set (cl &optional mode)
 197   "For CL window set focus mode to MODE.
 198 If MODE is ommited, `xwem-default-focus-mode' is used."
 199   (xwem-focus-set-focus-mode cl 'xwem-focus-mode mode))
 200
 201 ;; Some built-in focus modes
 202 (define-xwem-focus-mode generic ignore "Generic mode")
 203
 204 (define-xwem-focus-mode follow-mouse (cl action &optional xev)
 205   "Focus follow mouse"
 206   (cond ((and (eq action 'enter)
 207               (eq (X-Event-xcrossing-mode xev) X-NotifyNormal))
 208          (xwem-select-client cl))
 209         ))
 210
 211 ;;; Click to focus model
 212 (defvar xwem-focus-click-to-focus-map
 213   (let ((map (make-sparse-keymap)))
 214     (define-key map [button1] 'xwem-focus-click-on)
 215     (define-key map [button2] 'xwem-focus-click-on)
 216     (define-key map [button3] 'xwem-focus-click-on)
 217     map)
 218   "Keymap used for click to focus model.")
 219
 220 (defvar xwem-focus-click-minor-mode nil
 221   "*Non-nil mean `xwem-focus-click-to-focus-map' is enabled.")
 222 (xwem-make-variable-client-local 'xwem-focus-click-minor-mode)
 223
 224 (defun xwem-turn-on-focus-click-mode (cl)
 225   "On CL, turn on click to focus minor mode."
 226   (unless (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode)
 227     (when (xwem-misc-xwin-valid-p (xwem-cl-xwin cl))
 228       (xwem-kbd-install-grab xwem-focus-click-to-focus-map
 229                              (xwem-cl-xwin cl) X-GrabModeSync)
 230       (xwem-client-local-variable-set cl 'xwem-focus-click-minor-mode t))))
 231
 232 (defun xwem-turn-off-focus-click-mode (cl)
 233   "On CL, turn off click to focus minor mode."
 234   (when (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode)
 235     (when (xwem-misc-xwin-valid-p (xwem-cl-xwin cl))
 236       (XAllowEvents (xwem-dpy) X-ReplayPointer)
 237       (xwem-kbd-uninstall-grab xwem-focus-click-to-focus-map (xwem-cl-xwin cl))
 238       (xwem-client-local-variable-set cl 'xwem-focus-click-minor-mode nil))))
 239
 240 (defun xwem-focus-click-mode (cl)
 241   "On CL, toggle click to focus minor mode."
 242   (if (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode)
 243       (xwem-turn-off-focus-click-mode cl)
 244     (xwem-turn-on-focus-click-mode cl)))
 245
 246 ;;;###autoload(autoload 'xwem-focus-click-on "xwem-focus" nil t)
 247 (define-xwem-command xwem-focus-click-on ()
 248   "Command used by `click-focus' focus mode."
 249   (xwem-interactive)
 250
 251   (when (xwem-cl-p xwem-event-client)
 252     (xwem-select-client xwem-event-client))
 253
 254   ;; Pass the click
 255   (XAllowEvents (xwem-dpy) X-ReplayPointer))
 256
 257 (define-xwem-focus-mode click-focus (cl action &optional xev)
 258   "Click to focus"
 259   (cond ((and (eq action 'focus-in)
 260               (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal)
 261                   (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed)))
 262          ;; Remove button[123] from local keymap and ungrab it
 263          (xwem-turn-off-focus-click-mode cl))
 264
 265         ((and (eq action 'focus-out)
 266               (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal)
 267                   (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed)))
 268          ;; Add button[123] to local keymap and grab for it
 269          (xwem-turn-on-focus-click-mode cl))
 270
 271         ((memq action '(after-mode-change after-keymap-change))
 272          ;; Start grabing button1 in sync mode
 273          (unless (xwem-cl-selected-p cl)
 274            (xwem-turn-on-focus-click-mode cl)))
 275
 276         ((memq action '(before-mode-change before-keymap-change))
 277          ;; Remove button1 from local keymap and ungrab it
 278          (xwem-turn-off-focus-click-mode cl))))
 279
 280 ;; Register minor mode
 281 (xwem-add-minor-mode 'xwem-focus-click-minor-mode "Click"
 282                      'xwem-focus-click-to-focus-map)
 283
 284 \f
 285 (provide 'xwem-focus)
 286
 287 ;;; xwem-focus.el ends here