1. xemacs
  2. xwem


xwem / lisp / xwem-events.el

;;; xwem-events.el --- Events handlers.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;;         Steve Youngs  <steve@youngs.au.com>
;; Created: 21 Mar 2003
;; Keywords: xlib, 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
;; 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:
;; This file used to work with X events, also includes some events
;; handlers.
;;; Code
(require 'xwem-load)

(defun xwem-ev-reconfig (xdpy win xev)
  "Common ConfigureRequest handler."
  (let* ((win (X-Event-xconfigurerequest-window xev))
	 (cl (xwem-xwin-cl win))
	 (vmask (X-Event-xconfigurerequest-value-mask xev)))

    (X-Dpy-log (xwem-dpy) 'xwem-event "XWEM-EVENTS: ConfigureRequest event for win=%s vmask=%s, x=%S, y=%S, width=%S, height=%S"
	       '(X-Win-id win) 'vmask '(X-Event-xconfigurerequest-x xev) '(X-Event-xconfigurerequest-y xev)
	       '(X-Event-xconfigurerequest-width xev) '(X-Event-xconfigurerequest-height xev))

    ;; Handle configure requests only from xwem clients
    (when (xwem-cl-p cl)
      ;; Client window already in air
      (if (not (Xtest vmask (Xmask-or X-CWX X-CWY X-CWWidth X-CWHeight X-CWBorderWidth)))
          (xwem-cl-send-config cl)

        ;; Geometry change
        (setf (xwem-cl-new-xgeom cl)
              (make-X-Geom :x (and (Xtest vmask X-CWX) (X-Event-xconfigurerequest-x xev))
                           :y (and (Xtest vmask X-CWY) (X-Event-xconfigurerequest-y xev))
                           :width (and (Xtest vmask X-CWWidth) (X-Event-xconfigurerequest-width xev))
                           :height (and (Xtest vmask X-CWHeight) (X-Event-xconfigurerequest-height xev))
                           :border-width (and (Xtest vmask X-CWBorderWidth) (X-Event-xconfigurerequest-border-width xev))))
        (xwem-refit cl)))))

(defun xwem-ev-resize (xdpy win xev)
  "Handle ResizeRequest event."
  (let ((cl (xwem-xwin-cl (X-Event-xresizerequest-window xev))))
    (when (xwem-cl-p cl)
      (xwem-client-resize cl (X-Event-xresizerequest-width xev)
                          (X-Event-xresizerequest-height xev)))))

(defun xwem-ev-mapreq (xdpy win xev)
  "Handle MapRequest event."
  (let ((cl (xwem-xwin-cl (X-Event-xmaprequest-window xev))))
    (if (xwem-cl-p cl)
        ;; Transition from Withdrawn->Normal/Iconic state
        (xwem-cl-honour-init-state cl)

      ;; Initial window manage
      (xwem-xwin-try-to-manage (X-Event-xmaprequest-window xev)))))

(defun xwem-ev-unmap (xdpy win xev)
  "Handle UnmapNotify event."
  ;; NOTE: Obsolete X clients which does not send synthetic
  ;; UnmapNotify event (as described in ICCCM 4.1.4) to transit to
  ;; withdraw state, are not supported.
  (let (cl)
    (when (and (X-Event-synth-p xev)
               (not (X-Event-xunmap-from-configure xev))
               (xwem-cl-p (setq cl (xwem-xwin-cl (X-Event-xunmap-window xev))))
               (eq (xwem-cl-state cl) 'active))
      (xwem-withdraw cl))))

(defun xwem-ev-destroy (xdpy win xev)
  "Handle Destroy event."
  (let ((cl (xwem-xwin-cl (X-Event-xdestroywindow-window xev))))
    (when (xwem-cl-p cl)
      (xwem-cl-destroy cl))))

;;;; -- Events, command events, stuff --
(defun xwem-event-client (xev)
  "Return client where X event XEV occured."
  (let* ((xwin (and (X-Event-p xev)
                    (X-Event-CASE xev
                      ((:X-ButtonPress :X-ButtonRelease)
                       (X-Event-xbutton-event xev))
                       (X-Event-xmotion-event xev)))))
         (cl (or (and xwin (xwem-xwin-cl xwin)) (xwem-cl-selected))))

(defun xwem-next-event (&optional timeout evt-list)
  "Fetch next Emacs keyboard or mouse event, with corresponding X Event.

If EVT-LIST is given, stop when event of type that in EVT-LIST is
occured.  Default value of EVT-LIST is `(list X-KeyPress X-ButtonPress
X-ButtonRelease X-MotionNotify)'.

Return Emacs event.  To acces corresponding X Event use
`(event-object ev)' form."
  (let ((timo (and timeout (add-timeout timeout nil 'xwem-timeout)))
        (nev (allocate-event))
        (obj nil))

    (while (progn
             (next-event nev)
             (not (cond ((and (timeout-event-p nev)
                              (eq (event-object nev) 'xwem-timeout))
                         (setq timo nil) ; unset it

                        ((and (eval-event-p nev)
                              (X-Event-p (event-object nev))
                              (memq (X-Event-type (event-object nev))
                                    (or evt-list
                                        (list X-KeyPress X-ButtonPress
                                              X-ButtonRelease X-MotionNotify))))
                         ;; next-event can fetch only
                         ;; keypress/buttonpress/buttonrelease/motion
                         ;; events
                         (setq obj (event-object nev))))))
      (dispatch-event nev))
    (when timo
      (disable-timeout timo))
    (deallocate-event nev)

(defun xwem-xevent-emacs-event (xev)
  "Return Emacs event corresponding to X Event XEV."
  (X-Event-get-property xev 'emacs-event))

(defsetf xwem-xevent-emacs-event (xev) (eev)
  `(X-Event-put-property ,xev 'emacs-event ,eev))

(defun xwem-event-as-command (e-ev &optional x-ev)
  "Interpret event E-EV as command event.
Optional X-EV specifies corresponding X Event."
  ;; Remember some information about command invocation
  (setq xwem-last-xevent x-ev
        xwem-event-client (xwem-event-client x-ev)
        xwem-last-event e-ev
	xwem-this-command-keys (vconcat (and (not (xwem-kbd-global-map-current-p))
					(vector e-ev))))

(defun xwem-next-command-event (&optional prompt)
  "Return next command event.
Actually return cons cell where car is Emacs event and cdr is X Event."
  (let (eev cev xev)
    ;; Normal
    (when prompt
      (xwem-message 'prompt prompt))

    ;; Process while interesting event occur
    (while (and (setq eev (next-event))
                (not (cond ((and (eval-event-p eev)
                                 (X-Event-p (setq xev (event-object eev)))
                                 (memq (X-Event-type xev)
                                       (list X-KeyPress X-ButtonPress
                                             X-ButtonRelease X-MotionNotify))
                                 (setq cev (car (xwem-xevents->emacs-events (list xev) t))))
                            (X-Event-put-property xev 'emacs-event cev)

                           ((and (eval-event-p eev)
                                 (eventp (setq cev (event-object eev)))
                                 (eq (event-function eev) 'xwem-dispatch-command-event))
                            ;; Unread command event
                            (setq xev nil)
      (dispatch-event eev))

    (when prompt

    (xwem-event-as-command cev xev)
    (cons cev xev)))

(defun xwem-dispatch-command-event (eev &optional xev)
  "Dispatch command Emacs event EEV."
  (let* ((ecl (xwem-event-client xev))
         (bind (or (xwem-lookup-key ecl (vector eev))
                   ;; Then check for quit key
                   (and (equal xwem-quit-key (events-to-keys (vector eev)))
                   ;; Then accept even default bindings
                   (xwem-lookup-key ecl (vector eev) t))))
    ;; If some button press/release does not have binding - ignore it
    (unless (and (null bind) (button-event-p eev))
      (xwem-event-as-command eev xev)
      (xwem-kbd-dispatch-binding bind))))

(defun xwem-dispatch-command-xevent (xev)
  "Dispatch command event XEV."
  ;; If we are grabbing keyboard now and modifier pressed do nothing.
  (unless (or (= (X-Event-type xev) X-KeyRelease)
              (and (= (X-Event-type xev) X-KeyPress)
                   (xwem-kbd-kcode-modifier-p (X-Event-xkey-keycode xev))))
    (setf (xwem-xevent-emacs-event xev)
          (car (xwem-xevents->emacs-events (list xev) t)))
     (xwem-xevent-emacs-event xev) xev)))

;;; Unread command events support
(defun xwem-unread-command-event (eev-or-xev)
  "Make event EV to be readed by `xwem-next-command-event' later,
or to be executed by `xwem-dispatch-command-event'.
Event EV can be either Emacs event, or X-Event."
  (enqueue-eval-event (if (X-Event-p eev-or-xev)

(provide 'xwem-events)

;;; xwem-events.el ends here