[clfswm-cvs] r21 - in clfswm: . contrib
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sun Mar 9 14:20:10 UTC 2008
Author: pbrochard
Date: Sun Mar 9 09:20:09 2008
New Revision: 21
Added:
clfswm/contrib/clfswm
Modified:
clfswm/AUTHORS
clfswm/ChangeLog
clfswm/bindings.lisp
clfswm/clfswm-internal.lisp
clfswm/clfswm.lisp
clfswm/package.lisp
Log:
Check /home/phil/.config/clfswm/clfswmrc first. New clfswm script thanks to Xavier Maillard. Beginning of new window hook
Modified: clfswm/AUTHORS
==============================================================================
--- clfswm/AUTHORS (original)
+++ clfswm/AUTHORS Sun Mar 9 09:20:09 2008
@@ -4,6 +4,13 @@
Philippe Brochard hocwp at free dot fr
+Contributors
+------------
+
+Xavier Maillard xma at gnu dot org
+Cyrille THOUVENIN
+
+
-----------------------------------
Some of the CLFSWM code is based on
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sun Mar 9 09:20:09 2008
@@ -1,3 +1,20 @@
+2008-03-09 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (process-new-window): Beginning of new
+ window hook: each group have a hook to tell what he wants to do
+ with the new created window.
+
+2008-03-08 Xavier Maillard <xma at gnu.org>
+
+ * contrib/clfswm: New script. Dump a CLISP image of CLFSWM then
+ call the resulting executable.
+
+2008-03-08 Xavier Maillard <xma at gnu.org>
+
+ * clfswm.lisp (read-conf-file): Check for the user config file in
+ XDG_CONFIG_HOME *first*. Freedesktop.org standards should be
+ prefered whenever possible.
+
2008-02-27 Philippe Brochard <hocwp at free.fr>
* clfswm-layout.lisp (*-layout): Add an optional raise-p
Modified: clfswm/bindings.lisp
==============================================================================
--- clfswm/bindings.lisp (original)
+++ clfswm/bindings.lisp Sun Mar 9 09:20:09 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Mar 7 22:58:01 2008
+;;; #Date#: Sat Mar 8 21:13:30 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse
@@ -140,7 +140,7 @@
(replay-button-event)))
-(define-main-mouse (1) 'mouse-click-to-focus)
+(define-main-mouse (1) nil 'mouse-click-to-focus)
(define-main-mouse (4) 'mouse-select-next-level)
Modified: clfswm/clfswm-internal.lisp
==============================================================================
--- clfswm/clfswm-internal.lisp (original)
+++ clfswm/clfswm-internal.lisp Sun Mar 9 09:20:09 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Mar 7 22:25:37 2008
+;;; #Date#: Sun Mar 9 01:24:59 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -30,12 +30,17 @@
;;; Minimal hook
(defun call-hook (hook &optional args)
- "Call a hook (a function, a symbol or a list of function)"
- (when hook
- (typecase hook
- (cons (dolist (h hook)
- (call-hook h args)))
- (t (apply hook args)))))
+ "Call a hook (a function, a symbol or a list of functions)
+Return the result of the last hook"
+ (let ((result nil))
+ (labels ((rec (hook)
+ (when hook
+ (typecase hook
+ (cons (dolist (h hook)
+ (rec h)))
+ (t (setf result (apply hook args)))))))
+ (rec hook)
+ result)))
@@ -609,6 +614,46 @@
+(defun default-group-nw-hook (window)
+ (when (xlib:window-p *current-child*)
+ (leave-group)
+ (select-previous-level))
+ ;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
+ (when (group-p *current-child*)
+ (pushnew window (group-child *current-child*))) ;)
+ ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
+ (case (window-type window)
+ (:normal (adapt-child-to-father window *current-child*))
+ (t (place-window-from-hints window))))
+
+
+(defun open-in-new-group-nw-hook (group window)
+ (declare (ignore group))
+ (pushnew window (group-child *current-root*))
+ ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
+ (case (window-type window)
+ (:normal (adapt-child-to-father window *current-root*))
+ (t (place-window-from-hints window)))
+ (list t nil))
+
+
+
+(defun do-all-groups-nw-hook (window)
+ "Call nw-hook of each group. A hook must return one value or a list of two values.
+If the value or the first value is true then the default nw-hook is not executed.
+If the second value is true then no more group can do an action with the window (ie leave the loop)."
+ (let ((result nil))
+ (with-all-groups (*root-group* group)
+ (let ((ret (call-hook (group-nw-hook group) (list group window))))
+ (typecase ret
+ (cons (when (first ret)
+ (setf result t))
+ (when (second ret)
+ (return-from do-all-groups-nw-hook result)))
+ (t (when ret
+ (setf result t))))))
+ result))
+
(defun process-new-window (window)
"When a new window is created (or when we are scanning initial
windows), this function dresses the window up and gets it ready to be
@@ -622,17 +667,11 @@
(:transient 1)
(t 0)))
(grab-all-buttons window)
- (when (xlib:window-p *current-child*)
- (leave-group)
- (select-previous-level))
- ;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
- (when (group-p *current-child*)
- (pushnew window (group-child *current-child*))) ;)
+;; (when (group-p *current-child*) ;; PHIL: Remove this!!!
+;; (setf (group-nw-hook *current-child*) #'open-in-new-group-nw-hook))
+ (unless (do-all-groups-nw-hook window)
+ (default-group-nw-hook window))
(unhide-window window)
- ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
- (case (window-type window)
- (:normal (adapt-child-to-father window *current-child*))
- (t (place-window-from-hints window)))
(netwm-add-in-client-list window)))
Modified: clfswm/clfswm.lisp
==============================================================================
--- clfswm/clfswm.lisp (original)
+++ clfswm/clfswm.lisp Sun Mar 9 09:20:09 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Mar 7 21:16:29 2008
+;;; #Date#: Sun Mar 9 13:35:36 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -96,10 +96,8 @@
(defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
(declare (ignore event-slots))
(unless send-event-p
- ;; (unhide-window window)
(process-new-window window)
(xlib:map-window window)
- ;; (focus-window window)
(show-all-childs)))
@@ -247,7 +245,7 @@
(etc-conf (probe-file #p"/etc/clfswmrc"))
(config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm"))
:name "clfswmrc")))
- (conf (or user-conf etc-conf config-user-conf)))
+ (conf (or config-user-conf user-conf etc-conf)))
(if conf
(handler-case (load conf)
(error (c)
Added: clfswm/contrib/clfswm
==============================================================================
--- (empty file)
+++ clfswm/contrib/clfswm Sun Mar 9 09:20:09 2008
@@ -0,0 +1,54 @@
+#!/bin/bash -e
+#
+# #Date#:
+#
+# --------------------------------------------------------------------------
+# Documentation:
+#
+# Original code and idea: http://stumpwm.antidesktop.net/cgi-bin/wiki/SetUp
+#
+# This script is targeted to CLisp users. It will help in starting
+# CLFSWM quicker by dumping an image of CLFSWM.
+#
+# Installation:
+# Put this script wherever you want and just call it from your .xinitrc file
+#
+# The first time you will launch it, it will build the final
+# executable and then call it. To force a rebuild of your executable
+# (say you have updated something in the CLFSWM source tree), just
+# delete the image and restart your X session.
+# --------------------------------------------------------------------------
+
+# (C) 2008 Xavier Maillard <xma at gnu.org>
+
+# 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.
+#
+# --------------------------------------------------------------------------
+
+# Tweak this
+IMAGE="$HOME/var/cache/clfswm-$(cksum $(type -p clisp) | cut -d ' ' -f 1).core"
+ASDF=$HOME/usr/src/SVNed/clfswm
+CLFSWMASDPATH=$HOME/usr/share/common-lisp/systems
+
+if test ! -e "$x" ||
+ ( for i in "$(dirname $(readlink $CLFSWMASDPATH/clfswm.asd))"/*.lisp
+ do test "$x" -ot "$i" && exit 1
+ done )
+then
+ clisp -m 8MB -E ISO-8859-1 -q -K full -i $ASDF/asdf.lisp -x "(asdf:oos 'asdf:load-op :clfswm)\
+ (EXT:SAVEINITMEM \"$IMAGE\" :INIT-FUNCTION 'clfswm:main :EXECUTABLE t :norc t)"
+fi
+
+$IMAGE
Modified: clfswm/package.lisp
==============================================================================
--- clfswm/package.lisp (original)
+++ clfswm/package.lisp Sun Mar 9 09:20:09 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:52:01 2008
+;;; #Date#: Sat Mar 8 21:26:50 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Package definition
@@ -76,6 +76,8 @@
(rw :initarg :rw :accessor group-rw :initform 800)
(rh :initarg :rh :accessor group-rh :initform 600)
(layout :initarg :layout :accessor group-layout :initform nil)
+ (nw-hook :initarg :nw-hook :accessor group-nw-hook :initform nil
+ :documentation "Hook done by the group when a new window is mapped")
(window :initarg :window :accessor group-window :initform nil)
(gc :initarg :gc :accessor group-gc :initform nil)
(child :initarg :child :accessor group-child :initform nil)
More information about the clfswm-cvs
mailing list