Skip to content
Snippets Groups Projects
xwem-focus.el 5.71 KiB
Newer Older
viteno's avatar
viteno committed
;;; xwem-focus.el --- Controling focus under XWEM.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Fri Dec 19 13:25:30 MSK 2003
;; Keywords: xwem, xlib
;; 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:

;; Various focus operations.

;;; Code:


;;;###autoload
(defvar xwem-focus-stack nil
  "Last thing that has focus.
Internal variable, do not modify.")


;;;###autoload
(defun xwem-focus-xcurrent ()
  "Return current focus."
  (let ((cf (XGetInputFocus (xwem-dpy))))
    cf))

;;;###autoload
(defun xwem-focus-push (&optional xwin)
  "Push current focus or XWIN to `xwem-focus-stack'."
  (push (or xwin (xwem-focus-xcurrent)) xwem-focus-stack))

;;;###autoload
(defun xwem-focus-pop ()
  "Pop value from `xwem-focus-stack'."
  (pop xwem-focus-stack))

;;;###autoload
(defun xwem-focus-push-set (xwin)
  "Push current focus to `xwem-focus-stack' and set focus to XWIN."
  (xwem-focus-push)
  (XSetInputFocus (X-Win-dpy xwin) xwin X-RevertToParent))

;;;###autoload
(defun xwem-focus-pop-set ()
  "Pop from `xwem-focus-stack' and set focus."
  (let ((xwin (xwem-focus-pop)))
    (when (X-Win-p xwin)
      (XSetInputFocus (X-Win-dpy xwin) xwin X-RevertToParent))))

;;;###autoload
(defun xwem-focus-set (thing)
  "Set input focus to THING.
THING is one of X-Win, xwem-frame, or xwem-client."
  (cond ((or (X-Win-p thing) (numberp thing)) ; X11 window
	 (xwem-focus-push-set thing))

	;; xwem client
	((xwem-cl-p thing)
	 (xwem-focus-set (xwem-cl-xwin thing))
	 (when (XWMProtocol-set-p (xwem-dpy)
		 (xwem-hints-wm-protocols (xwem-cl-hints thing))
		 "WM_TAKE_FOCUS")
	   (xwem-client-sendmsg-atom thing
             (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS"))))

	;; xwem window
	((xwem-win-p thing)
	 (xwem-focus-set (xwem-win-frame thing)))

	;; xwem-frame
	((xwem-frame-p thing)
	 (let* ((cl (xwem-win-cl (xwem-frame-selwin thing)))
		(embf (and (xwem-cl-p cl)
			   (xwem-frame-find 'xwin (xwem-cl-xwin cl))))) ; maybe cl is embedded frame

	   (if (xwem-frame-p embf)
	       ;; embedded frame
	       (xwem-focus-set embf)
		     
	     (if (xwem-cl-p cl)
		 ;; Current client active
		 (xwem-focus-set cl)

	       (xwem-focus-set (xwem-frame-xwin thing))))))

	;; Normally should not happen
	(t (xwem-message 'warn "Strange thing to focus: %S" thing))))

;;;###autoload
(defmacro xwem-focus-excursion (xwin &rest forms)
  "Do FORMS, saving current input focus and under XWIN focus."
  `(prog2
     (xwem-focus-push-set xwin)
     ,@forms
     (xwem-focus-pop-set)))


;;; Focus modes support
;;;###autoload
(defcustom xwem-default-focus-mode 'generic
  "*Default CL's focus mode."
  :type '(choice (const :tag "Generic mode" generic)
		 (const :tag "Click to focus" click-focus)
		 (const :tag "Follow mouse" follow-mouse))
  :group 'xwem)

(defvar xwem-focus-modes nil
  "Alist of focus modes, car is mode name, cdr is function.")

(defun xwem-focus-mode-define (name fun)
  "Define new focus mode named by NAME.
FUN specifies function to call when focus changes."
  (add-to-list 'xwem-focus-modes (cons name fun))
  (put name 'xwem-focus-mode fun))

;;;###autoload
(defun xwem-focus-mode-invoke (cl &rest args)
  "Invoke CL's focus mode function with ARGS."
  (when (xwem-cl-p cl)
    (let* ((mode (xwem-cl-get-prop cl 'xwem-focus-mode))
	   (fun (get mode 'xwem-focus-mode)))
      (when fun
	(apply fun cl args)))))

;;;###autoload
(defun xwem-focus-mode-set (cl mode)
  "For CL window set focus mode to MODE."
  (unless (eq (xwem-cl-get-prop cl 'xwem-focus-mode) mode)
    (xwem-focus-mode-invoke cl 'before-mode-change)
    (xwem-cl-put-prop cl 'xwem-focus-mode mode)
    (xwem-focus-mode-invoke cl 'after-mode-change)))

;; Some built-in focus modes
(xwem-focus-mode-define 'generic
  (lambda (cl action &optional xev)
    nil))

(xwem-focus-mode-define 'follow-mouse
  (lambda (cl action &optional xev)
    (cond ((and (eq action 'enter)
		(eq (X-Event-xcrossing-mode xev) X-NotifyNormal))
	   (xwem-cl-pop-to-client cl))
	  )))

(define-xwem-command xwem-focus-click-on ()
  "Command used by `click-focus' focus mode."
  (xwem-interactive)

  (let* ((xev xwem-last-xevent)
	 (cl (xwem-find-client (X-Event-win xev))))
    (when (xwem-cl-p cl)
      (xwem-cl-pop-to-client cl))))

(xwem-focus-mode-define 'click-focus
  (lambda (cl action &optional xev)
    (cond ((and (eq action 'focus-in)
		(or (eq (X-Event-xfocus-mode xev) X-NotifyNormal)
		    (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed)))
	   ;; Remove button1 from local keymap and ungrab it
	   (xwem-message 'info "focus in"))

	  ((and (eq action 'focus-out)
		(or (eq (X-Event-xfocus-mode xev) X-NotifyNormal)
		    (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed)))
	   ;; Add button1 to local keymap and grab for it
	   (xwem-local-set-key [button1] 'xwem-focus-click-on cl)
	   (xwem-message 'info "focus out"))

	  ((eq action 'before-mode-change)
	   ;; Remove button1 from local keymap and ungrab it
	   )
	  )))
	       
(put 'xwem-focus-mode-define 'lisp-indent-function 1)


(provide 'xwem-focus)

;;; xwem-focus.el ends here