Newer
Older
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
;;; --------------------------------------------------------------------------
;;;
;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
;;;
;;; This program 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 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program 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 this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;;
;;; --------------------------------------------------------------------------
(in-package :clfswm)
Philippe Brochard
committed
(define-handler main-mode :key-press (code state)
Philippe Brochard
committed
(define-handler main-mode :button-press (code state window root-x root-y)
(unless (funcall-button-from-code *main-mouse* code state window root-x root-y *fun-press*)
(replay-button-event)))
Philippe Brochard
committed
(define-handler main-mode :button-release (code state window root-x root-y)
(unless (funcall-button-from-code *main-mouse* code state window root-x root-y *fun-release*)
(replay-button-event)))
Philippe Brochard
committed
(define-handler main-mode :motion-notify (window root-x root-y)
Philippe Brochard
committed
(funcall-button-from-code *main-mouse* 'motion
(modifiers->state *default-modifiers*)
window root-x root-y *fun-press*)))
Philippe Brochard
committed
Philippe Brochard
committed
(define-handler main-mode :configure-request (stack-mode window x y width height border-width value-mask)
Philippe Brochard
committed
(let ((change nil))
Philippe Brochard
committed
(labels ((has-x (mask) (= 1 (logand mask 1)))
(has-y (mask) (= 2 (logand mask 2)))
(has-w (mask) (= 4 (logand mask 4)))
(has-h (mask) (= 8 (logand mask 8)))
(has-bw (mask) (= 16 (logand mask 16)))
(has-stackmode (mask) (= 64 (logand mask 64)))
(adjust-from-request ()
Philippe Brochard
committed
(when (has-x value-mask) (setf (x-drawable-x window) x
change :moved))
(when (has-y value-mask) (setf (x-drawable-y window) y
change :moved))
(when (has-h value-mask) (setf (x-drawable-height window) height
change :resized))
(when (has-w value-mask) (setf (x-drawable-width window) width
change :resized))))
Philippe Brochard
committed
(when window
Philippe Brochard
committed
(xlib:with-state (window)
(let ((current-root (find-current-root)))
(if (find-child window current-root)
(let ((parent (find-parent-frame window current-root)))
(if (and parent (managed-window-p window parent))
Philippe Brochard
committed
(setf change (adapt-child-to-parent window parent))
Philippe Brochard
committed
(adjust-from-request)))
(adjust-from-request)))
Philippe Brochard
committed
(when (has-bw value-mask)
(setf (x-drawable-border-width window) border-width
change :resized))
Philippe Brochard
committed
(when (has-stackmode value-mask)
(case stack-mode
(:above
(unless (null-size-window-p window)
(when (or (child-equal-p window (current-child))
(is-in-current-child-p window))
Philippe Brochard
committed
(setf change (or change :moved))
Philippe Brochard
committed
(raise-window window)
(focus-window window)
Philippe Brochard
committed
(focus-all-children window (find-parent-frame window (find-current-root)))))))))
Philippe Brochard
committed
(unless (eq change :resized)
Philippe Brochard
committed
;; To be ICCCM compliant, send a fake configuration notify event only when
;; the window has moved and not when it has been resized or the border width has changed.
Philippe Brochard
committed
(send-configuration-notify window (x-drawable-x window) (x-drawable-y window)
(x-drawable-width window) (x-drawable-height window)
(x-drawable-border-width window)))))))
Philippe Brochard
committed
Philippe Brochard
committed
(define-handler main-mode :map-request (window send-event-p)
Philippe Brochard
committed
(unless (find-child window *root-frame*)
(unhide-window window)
(process-new-window window)
(map-window window)
(unless (null-size-window-p window)
(multiple-value-bind (never-managed raise)
(never-managed-window-p window)
(unless (and never-managed raise)
(show-all-children)))))))
Philippe Brochard
committed
Philippe Brochard
committed
Philippe Brochard
committed
Philippe Brochard
committed
(define-handler main-mode :unmap-notify (send-event-p event-window window)
(unless (and (not send-event-p)
(not (xlib:window-equal window event-window)))
(when (find-child window *root-frame*)
Philippe Brochard
committed
(setf (window-state window) +withdrawn-state+)
(xlib:unmap-window window)
Philippe Brochard
committed
(delete-child-in-all-frames window)
Philippe Brochard
committed
(show-all-children))))
Philippe Brochard
committed
Philippe Brochard
committed
Philippe Brochard
committed
(define-handler main-mode :destroy-notify (send-event-p event-window window)
(unless (or send-event-p
(xlib:window-equal window event-window))
(when (find-child window *root-frame*)
Philippe Brochard
committed
(delete-child-in-all-frames window)
Philippe Brochard
committed
(show-all-children)
(xlib:destroy-window window))))
Philippe Brochard
committed
(define-handler main-mode :enter-notify (window root-x root-y)
Philippe Brochard
committed
(unless (and (> root-x (- (xlib:screen-width *screen*) 3))
(> root-y (- (xlib:screen-height *screen*) 3)))
Philippe Brochard
committed
(case (if (frame-p (current-child))
(frame-focus-policy (current-child))
Philippe Brochard
committed
*default-focus-policy*)
(:sloppy (focus-window window))
Philippe Brochard
committed
(:sloppy-strict (when (and (frame-p (current-child))
(child-member window (frame-child (current-child))))
Philippe Brochard
committed
(focus-window window)))
(:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child)))
(unless (or (child-root-p child)
Philippe Brochard
committed
(equal (typecase child
(xlib:window parent)
(t child))
Philippe Brochard
committed
(current-child)))
Philippe Brochard
committed
(focus-all-children child parent)
(show-all-children)))))))
Philippe Brochard
committed
Philippe Brochard
committed
(define-handler main-mode :exposure (window)
(awhen (find-frame-window window)
Philippe Brochard
committed
(define-handler main-mode :configure-notify (window)
(when (child-equal-p window *root*)
(place-frames-from-xinerama-infos)
(finish-configuring-root)
Philippe Brochard
committed
(show-all-children)
(call-hook *root-size-change*)))
Philippe Brochard
committed
Philippe Brochard
committed
(defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys)
"Handle X errors"
(cond
;; ignore asynchronous window errors
((and asynchronous
(find error-key '(xlib:window-error xlib:drawable-error xlib:match-error)))
#+:xlib-debug (format t "~&Ignoring XLib asynchronous error: ~s~%" error-key))
Philippe Brochard
committed
((eq error-key 'xlib:access-error)
Philippe Brochard
committed
(write-line "~&Another window manager is running.")
(throw 'exit-clfswm nil))
;; all other asynchronous errors are printed.
(asynchronous
#+:xlib-debug (format t "~&Caught Asynchronous X Error: ~s ~s" error-key key-vals))
Philippe Brochard
committed
;;((find error-key '(xlib:window-error xlib:drawable-error xlib:match-error))
;; (format t "~&Ignoring Xlib error: ~S ~S~%" error-key key-vals))
(t
(apply 'error error-key :display display :error-key error-key key-vals))))
Philippe Brochard
committed
Philippe Brochard
committed
(with-xlib-protect (:main-loop nil)
(call-hook *loop-hook*)
(process-timers)
Philippe Brochard
committed
(when (xlib:event-listen *display* *loop-timeout*)
Philippe Brochard
committed
(xlib:process-event *display* :handler #'handle-event))
Philippe Brochard
committed
(xlib:display-finish-output *display*)
(setf *x-error-count* 0))))
Philippe Brochard
committed
Philippe Brochard
committed
(defun open-display (display-str protocol)
(multiple-value-bind (host display-num) (parse-display-string display-str)
(setf *display* (xlib:open-display host :display display-num :protocol protocol)
Philippe Brochard
committed
(xlib:display-error-handler *display*) 'error-handler
Philippe Brochard
committed
(defun default-init-hook ()
Philippe Brochard
committed
(place-frames-from-xinerama-infos)
(finish-configuring-root))
Philippe Brochard
committed
(reset-root-list)
Philippe Brochard
committed
(reset-bind-or-jump-slots)
Philippe Brochard
committed
(reset-open-menu)
Philippe Brochard
committed
(fill-handle-event-fun-symbols)
Philippe Brochard
committed
(assoc-keyword-handle-event 'main-mode)
(setf *screen* (first (xlib:display-roots *display*))
*root* (xlib:screen-root *screen*)
*no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
*default-font* (xlib:open-font *display* *default-font-string*)
*pixmap-buffer* (xlib:create-pixmap :width (xlib:screen-width *screen*)
:height (xlib:screen-height *screen*)
:depth (xlib:screen-root-depth *screen*)
Philippe Brochard
committed
:drawable *root*)
Philippe Brochard
committed
*in-second-mode* nil
*x-error-count* 0)
Philippe Brochard
committed
(init-modifier-list)
Philippe Brochard
committed
(init-last-child)
Philippe Brochard
committed
(call-hook *binding-hook*)
Philippe Brochard
committed
(clear-timers)
(map-window *no-focus-window*)
(dbg *display*)
(setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
:substructure-notify
Philippe Brochard
committed
:structure-notify
Philippe Brochard
committed
;;:resize-redirect
:exposure
:button-press
:button-release
:pointer-motion))
Philippe Brochard
committed
(xlib:display-finish-output *display*)
;;(intern-atoms *display*)
(netwm-set-properties)
(xlib:display-force-output *display*)
(setf *child-selection* nil)
(setf *root-frame* (create-frame :name "Root" :number 0)
Philippe Brochard
committed
(current-child) *root-frame*)
(call-hook *init-hook*)
(process-existing-windows *screen*)
Philippe Brochard
committed
(show-all-children)
Philippe Brochard
committed
(xlib:display-finish-output *display*)
(optimize-event-hook))
Philippe Brochard
committed
(let* ((conf (conf-file-name)))
(format t "~2%*** Error loading configuration file: ~A ***~&~A~%" conf c)
(values nil (format nil "~s" c) conf))
(:no-error (&rest args)
(declare (ignore args))
(values t nil conf)))
(values t nil nil))))
Philippe Brochard
committed
(defun exit-clfswm ()
"Exit clfswm"
(throw 'exit-clfswm nil))
(defun reset-clfswm ()
"Reset clfswm"
(throw 'exit-main-loop nil))
Philippe Brochard
committed
(defun main-unprotected (&key (display (or (getenv "DISPLAY") ":0")) protocol
(base-dir (asdf:system-source-directory :clfswm))
Philippe Brochard
committed
(read-conf-file-p t) (alternate-conf nil)
Philippe Brochard
committed
error-msg)
(setf *contrib-dir* (merge-pathnames "contrib/" base-dir))
Philippe Brochard
committed
(conf-file-name alternate-conf)
Philippe Brochard
committed
(when read-conf-file-p
(read-conf-file))
Philippe Brochard
committed
(create-configuration-menu :clear t)
Philippe Brochard
committed
(call-hook *main-entrance-hook*)
(handler-case
(open-display display protocol)
(xlib:access-error (c)
Philippe Brochard
committed
(format t "~&~A~&Maybe another window manager is running. [1]~%" c)
Philippe Brochard
committed
(exit-clfswm)))
(handler-case
(init-display)
(xlib:access-error (c)
(ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
(xlib:close-display *display*)
Philippe Brochard
committed
(format t "~&~A~&Maybe another window manager is running. [2]~%" c)
Philippe Brochard
committed
(exit-clfswm)))
Philippe Brochard
committed
(when error-msg
(info-mode error-msg))
Philippe Brochard
committed
(catch 'exit-main-loop
(unwind-protect
(main-loop)
Philippe Brochard
committed
(progn
(ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
(xlib:free-pixmap *pixmap-buffer*)
(destroy-all-frames-window)
(call-hook *close-hook*)
(clear-event-hooks)
(xlib:close-display *display*)
#+:event-debug
(format t "~2&Unhandled events: ~A~%" *unhandled-events*)))))
Philippe Brochard
committed
Philippe Brochard
committed
Philippe Brochard
committed
(defun main (&key (display (or (getenv "DISPLAY") ":0")) protocol
(base-dir (asdf:system-source-directory :clfswm))
Philippe Brochard
committed
(read-conf-file-p t)
(alternate-conf nil))
Philippe Brochard
committed
(let (error-msg)
(catch 'exit-clfswm
(loop
(handler-case
Philippe Brochard
committed
(if *other-window-manager*
(run-other-window-manager)
(main-unprotected :display display :protocol protocol :base-dir base-dir
:read-conf-file-p read-conf-file-p
:alternate-conf alternate-conf
:error-msg error-msg))
Philippe Brochard
committed
(error (c)
(let ((msg (format nil "CLFSWM Error: ~A." c)))
(format t "~&~A~%Reinitializing...~%" msg)
(setf error-msg (list (list msg *info-color-title*)
"Reinitializing...")))))))))