[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Sun Feb 24 20:53:40 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv8075
Modified Files:
ChangeLog bindings-pager.lisp bindings-second-mode.lisp
bindings.lisp clfswm-info.lisp clfswm-internal.lisp
clfswm-keys.lisp clfswm-pack.lisp clfswm-second-mode.lisp
clfswm-util.lisp clfswm.asd clfswm.lisp config.lisp
keysyms.lisp load.lisp netwm-util.lisp package.lisp tools.lisp
xlib-util.lisp
Added Files:
clfswm-layout.lisp
Removed Files:
clfswm-pager.lisp
Log Message:
Major update - No more reference to workspaces
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2008/01/03 22:15:48 1.14
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2008/02/24 20:53:37 1.15
@@ -1,3 +1,21 @@
+2008-02-24 Philippe Brochard <hocwp at free.fr>
+
+ * *: Major update - No more reference to workspaces. The main
+ structure is a tree of groups or application windows.
+
+2008-02-07 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (read-conf-file): Read configuration in
+ $HOME/.clfswmrc or in /etc/clfswmrc or in
+ $XDG_CONFIG_HOME/clfswm/clfswmrc.
+ (xdg-config-home): Return the content of $XDG-CONFIG-HOME (default
+ to $HOME/.config/).
+
+2008-01-18 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (show-all-group): Use *root* and *root-gc*
+ by default.
+
2008-01-03 Philippe Brochard <hocwp at free.fr>
* clfswm-internal.lisp (find-window-group): New function.
--- /project/clfswm/cvsroot/clfswm/bindings-pager.lisp 2008/01/04 22:57:22 1.8
+++ /project/clfswm/cvsroot/clfswm/bindings-pager.lisp 2008/02/24 20:53:37 1.9
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Jan 4 23:56:09 2008
+;;; #Date#: Tue Feb 12 14:02:07 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for pager mode
@@ -253,9 +253,9 @@
(defmacro define-pager-focus-workspace-by-number (key number)
"Define a pager key to focus a workspace by its number"
`(define-pager-key ,key
- (defun ,(create-symbol (format nil "b-pager-focus-workspace-~A" number)) ()
- ,(format nil "Focus workspace ~A" number)
- (pager-select-workspace-by-number ,number))))
+ (defun ,(create-symbol (format nil "b-pager-focus-workspace-~A" number)) ()
+ ,(format nil "Focus workspace ~A" number)
+ (pager-select-workspace-by-number ,number))))
(define-pager-focus-workspace-by-number (#\1 :mod-1) 1)
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/01/03 22:15:48 1.11
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/24 20:53:37 1.12
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 23:13:40 2008
+;;; #Date#: Sun Feb 24 21:34:42 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -34,553 +34,660 @@
;;;|
;;;| CONFIG - Second mode bindings
;;;`-----
-(defun leave-second-mode-maximize ()
- "Leave second mode and maximize current group"
- (maximize-group (current-group))
- (banish-pointer)
- (show-all-windows-in-workspace (current-workspace))
- (throw 'exit-second-loop nil))
-
-(defun leave-second-mode ()
- "Leave second mode"
- (banish-pointer)
- (show-all-windows-in-workspace (current-workspace))
- (throw 'exit-second-loop nil))
-(define-second-key ("F1" :mod-1) 'help-on-second-mode)
-
-(define-second-key (#\g :control) 'stop-all-pending-actions)
-
-(define-second-key (#\i) 'identify-key)
-
-(define-second-key (#\:) 'eval-from-query-string)
-
-
-(defun run-program-from-query-string ()
- "Run a program from the query input"
- (let ((program (query-string "Run:")))
- (when (and program (not (equal program "")))
- (setf *second-mode-program* program)
- (leave-second-mode))))
-
-(define-second-key (#\!) 'run-program-from-query-string)
-
-
-(define-second-key (#\t) 'leave-second-mode-maximize)
-(define-second-key ("Return") 'leave-second-mode-maximize)
-(define-second-key ("Escape") 'leave-second-mode)
-
-
-(define-second-key (#\< :control) 'leave-second-mode)
-(define-second-key ("Return" :control) 'leave-second-mode)
-
-;; Escape
-(define-second-key ("Escape" :control :shift) 'delete-current-window)
-(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
-(define-second-key ("Escape" :control) 'remove-current-window)
-(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
-
-
-;; Up
-(define-second-key ("Up" :mod-1) 'circulate-group-up)
-(define-second-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
-(define-second-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
-
-
-;; Down
-(define-second-key ("Down" :mod-1) 'circulate-group-down)
-(define-second-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
-(define-second-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
-
-
-;; Right
-(define-second-key ("Right" :mod-1) 'circulate-workspace-up)
-(define-second-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
-(define-second-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
-
-
-;; Left
-(define-second-key ("Left" :mod-1) 'circulate-workspace-down)
-(define-second-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
-(define-second-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
-
-
-(defmacro define-second-focus-workspace-by-number (key number)
- "Define a second key to focus a workspace by its number"
- `(define-second-key ,key
- (defun ,(create-symbol (format nil "b-second-focus-workspace-~A" number)) ()
- ,(format nil "Focus workspace ~A" number)
- (circulate-workspace-by-number ,number))))
-(define-second-focus-workspace-by-number (#\1 :mod-1) 1)
-(define-second-focus-workspace-by-number (#\2 :mod-1) 2)
-(define-second-focus-workspace-by-number (#\3 :mod-1) 3)
-(define-second-focus-workspace-by-number (#\4 :mod-1) 4)
-(define-second-focus-workspace-by-number (#\5 :mod-1) 5)
-(define-second-focus-workspace-by-number (#\6 :mod-1) 6)
-(define-second-focus-workspace-by-number (#\7 :mod-1) 7)
-(define-second-focus-workspace-by-number (#\8 :mod-1) 8)
-(define-second-focus-workspace-by-number (#\9 :mod-1) 9)
-(define-second-focus-workspace-by-number (#\0 :mod-1) 10)
+;;;;;;;;;;;;;;;
+;; Menu entry
+;;;;;;;;;;;;;;;
+(defun group-adding-menu ()
+ "Open the adding group menu"
+ (info-mode-menu '((#\a add-default-group)
+ (#\p add-placed-group))))
+
+(defun group-layout-menu ()
+ "Open the group layout menu"
+ (info-mode-menu (loop for l in *layout-list*
+ for i from 0
+ collect (list (code-char (+ (char-code #\a) i)) l))))
+
+
+
+
+
+(defun group-pack-menu ()
+ "Open the group pack menu"
+ (info-mode-menu '(("Up" group-pack-up)
+ ("Down" group-pack-down))))
+
+
+(defun group-movement-menu ()
+ "Open the movement menu"
+ (info-mode-menu '((#\p group-pack-menu)
+ (#\f group-fill-menu)
+ (#\r group-resize-menu))))
+
+
+(defun group-pack-up ()
+ "Pack group up"
+ (print 'pack-up)
+ (group-movement-menu))
+
+(defun group-pack-down ()
+ "Pack group down"
+ (print 'pack-down)
+ (group-movement-menu))
-(define-second-key (#\1 :control :mod-1) 'renumber-workspaces)
-(define-second-key (#\2 :control :mod-1) 'sort-workspaces)
+(defun group-menu ()
+ "Open the group menu"
+ (info-mode-menu '((#\a group-adding-menu)
+ (#\l group-layout-menu)
+ (#\m group-movement-menu))))
+
+
+(defun utility-menu ()
+ "Open the utility menu"
+ (info-mode-menu '((#\i identify-key)
+ (#\: eval-from-query-string)
+ (#\! run-program-from-query-string))))
+
+(defun main-menu ()
+ "Open the main menu"
+ (info-mode-menu '((#\g group-menu)
+ (#\w window-menu)
+ (#\s selection-menu)
+ (#\u utility-menu))))
-(define-second-key ("Tab" :mod-1) 'rotate-window-up)
-(define-second-key ("Tab" :mod-1 :shift) 'rotate-window-down)
-(define-second-key (#\b) 'banish-pointer)
-(define-second-key (#\b :mod-1) 'toggle-maximize-current-group)
-(define-second-key (#\x) 'pager-mode)
-
-
-(define-second-key (#\k :mod-1) 'destroy-current-window)
-(define-second-key (#\k) 'remove-current-window)
-
-
-(define-second-key (#\g) 'create-new-default-group)
-(define-second-key (#\g :mod-1) 'remove-current-group)
-
-(define-second-key (#\w) 'create-new-default-workspace)
-(define-second-key (#\w :mod-1) 'remove-current-workspace)
-
-(define-second-key (#\o)
- (defun b-open-next-window-in-new-workspace ()
- "Open the next window in a new workspace"
- (setf *open-next-window-in-new-workspace* t)
- (leave-second-mode)))
-
-(define-second-key (#\o :control)
- (defun b-open-next-window-in-workspace-numbered ()
- "Open the next window in a numbered workspace"
- (let ((number (parse-integer (or (query-string "Open next window in workspace:") "")
- :junk-allowed t)))
- (when (numberp number)
- (setf *open-next-window-in-new-workspace* number)))
- (leave-second-mode)))
-
-
-(define-second-key (#\o :mod-1)
- (defun b-open-next-window-in-new-group-once ()
- "Open the next window in a new group and all others in the same group"
- (setf *open-next-window-in-new-group* :once)
- (leave-second-mode)))
-
-(define-second-key (#\o :mod-1 :control)
- (defun b-open-next-window-in-new-group ()
- "Open each next window in a new group"
- (setf *open-next-window-in-new-group* t)
- (leave-second-mode)))
-
-
-
-(defmacro define-shell (key name docstring cmd)
- "Define a second key to start a shell command"
- `(define-second-key ,key
- (defun ,name ()
- ,docstring
- (setf *second-mode-program* ,cmd)
- (leave-second-mode))))
-
-(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm")
-(define-shell (#\e) b-start-emacs "start emacs" "exec emacs")
-(define-shell (#\e :control) b-start-emacsremote
- "start an emacs for another user"
- "exec emacsremote-Eterm")
-(define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d")
-
-
-(define-second-key (#\a) 'force-window-center-in-group)
-(define-second-key (#\a :mod-1) 'force-window-in-group)
+(define-second-key ("F1" :mod-1) 'help-on-second-mode)
+(define-second-key ("m") 'main-menu)
+(define-second-key ("g") 'group-menu)
-(define-second-key (#\d :mod-1)
- (defun b-show-debuging-info ()
- "Show debuging info"
- (dbg *workspace-list*)
- (dbg *screen*)
- (dbg (query-tree *root*))))
-(define-second-key (#\t :control) 'tile-current-workspace-vertically)
-(define-second-key (#\t :shift :control) 'tile-current-workspace-horizontally)
+;;(define-second-key (#\g :control) 'stop-all-pending-actions)
-(define-second-key (#\y) 'tile-current-workspace-to)
-(define-second-key (#\y :mod-1) 'reconfigure-tile-workspace)
-(define-second-key (#\y :control) 'explode-current-group)
-(define-second-key (#\y :control :shift) 'implode-current-group)
-
-;;;,-----
-;;;| Moving/Resizing groups
-;;;`-----
-(define-second-key (#\p)
- (defun b-pack-group-on-next-arrow ()
- "Pack group on next arrow action"
- (setf *arrow-action* :pack)))
-
-
-(defun fill-group-in-all-directions ()
- "Fill group in all directions"
- (fill-current-group-up)
- (fill-current-group-left)
- (fill-current-group-right)
- (fill-current-group-down))
-
-
-(define-second-key (#\f)
- (defun b-fill-group ()
- "Fill group on next arrow action (fill in all directions on second f keypress)"
- (case *arrow-action*
- (:fill (fill-group-in-all-directions)
- (setf *arrow-action* nil))
- (t (setf *arrow-action* :fill)))))
-
-(define-second-key (#\f :mod-1) 'fill-group-in-all-directions)
-
-(define-second-key (#\f :shift)
- (defun b-fill-group-vert ()
- "Fill group vertically"
- (fill-current-group-up)
- (fill-current-group-down)))
-
-(define-second-key (#\f :control)
- (defun b-fill-group-horiz ()
- "Fill group horizontally"
- (fill-current-group-left)
- (fill-current-group-right)))
-
-
-(define-second-key (#\r)
- (defun b-resize-half ()
- "Resize group to its half width or heigth on next arraw action"
- (setf *arrow-action* :resize-half)))
-
-
-(define-second-key (#\l) 'resize-minimal-current-group)
-(define-second-key (#\l :mod-1) 'resize-down-current-group)
-
-
-(define-second-key (#\m) 'center-current-group)
-
-
-(define-second-key ("Up")
- (defun b-move-or-pack-up ()
- "Move, pack, fill or resize group up"
- (case *arrow-action*
- (:pack (pack-current-group-up))
- (:fill (fill-current-group-up))
- (:resize-half (resize-half-height-up-current-group))
- (t (move-group (current-group) 0 -10)))
- (setf *arrow-action* nil)))
-
-(define-second-key ("Down")
- (defun b-move-or-pack-down ()
- "Move, pack, fill or resize group down"
- (case *arrow-action*
- (:pack (pack-current-group-down))
- (:fill (fill-current-group-down))
- (:resize-half (resize-half-height-down-current-group))
- (t (move-group (current-group) 0 +10)))
- (setf *arrow-action* nil)))
-
-(define-second-key ("Right")
- (defun b-move-or-pack-right ()
- "Move, pack, fill or resize group right"
- (case *arrow-action*
- (:pack (pack-current-group-right))
- (:fill (fill-current-group-right))
- (:resize-half (resize-half-width-right-current-group))
- (t (move-group (current-group) +10 0)))
- (setf *arrow-action* nil)))
-
-(define-second-key ("Left")
- (defun b-move-or-pack-left ()
- "Move, pack, fill or resize group left"
- (case *arrow-action*
- (:pack (pack-current-group-left))
- (:fill (fill-current-group-left))
- (:resize-half (resize-half-width-left-current-group))
- (t (move-group (current-group) -10 0)))
- (setf *arrow-action* nil)))
-
-
-(define-second-key ("Up" :shift)
- (defun b-resize-up ()
- "Resize group up"
- (resize-group (current-group) 0 -10)))
-
-(define-second-key ("Down" :shift)
- (defun b-resize-down ()
- "Resize group down"
- (resize-group (current-group) 0 +10)))
-
-(define-second-key ("Right" :shift)
- (defun b-resize-right ()
- "Resize group right"
- (resize-group (current-group) +10 0)))
-
-(define-second-key ("Left" :shift)
- (defun b-resize-left ()
- "Resize group left"
- (resize-group (current-group) -10 0)))
+(define-second-key (#\i) 'identify-key)
+(define-second-key (#\:) 'eval-from-query-string)
+(define-second-key (#\!) 'run-program-from-query-string)
-;;;,-----
-;;;| Mouse second mode functions
-;;;`-----
-(defun select-group-under-mouse (root-x root-y)
- (let ((group (find-group-under-mouse root-x root-y)))
- (when group
- (no-focus)
- (focus-group group (current-workspace))
- (focus-window (current-window))
- (show-all-group (current-workspace)))))
-
-(defun mouse-leave-second-mode-maximize (root-x root-y)
- "Leave second mode and maximize current group"
- (select-group-under-mouse root-x root-y)
- (maximize-group (current-group))
- (show-all-windows-in-workspace (current-workspace))
- (throw 'exit-second-loop nil))
-
-(defun mouse-leave-second-mode (root-x root-y)
- "Leave second mode"
- (select-group-under-mouse root-x root-y)
- (show-all-windows-in-workspace (current-workspace))
[793 lines skipped]
--- /project/clfswm/cvsroot/clfswm/bindings.lisp 2008/01/03 20:31:24 1.6
+++ /project/clfswm/cvsroot/clfswm/bindings.lisp 2008/02/24 20:53:37 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 19:23:24 2008
+;;; #Date#: Sun Feb 24 21:34:48 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse
@@ -33,72 +33,141 @@
;;;| CONFIG - Bindings main mode
;;;`-----
+
(define-main-key ("F1" :mod-1) 'help-on-clfswm)
(defun quit-clfswm ()
"Quit clfswm"
- (throw 'quit-main-loop nil))
-
-
+ (throw 'exit-main-loop nil))
(define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
-(define-main-key (#\t :mod-1) 'second-key-mode)
-(define-main-key ("less" :control) 'second-key-mode)
-
-(define-main-key ("Tab" :mod-1) 'rotate-window-up)
-(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
-
-(define-main-key (#\b :mod-1) 'banish-pointer)
-(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
-
-;; Escape
-(define-main-key ("Escape" :control :shift) 'delete-current-window)
-(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
-(define-main-key ("Escape" :control) 'remove-current-window)
-(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
+(define-main-key ("Right" :mod-1) 'select-next-brother)
+(define-main-key ("Left" :mod-1) 'select-previous-brother)
+(define-main-key ("Down" :mod-1) 'select-next-level)
+(define-main-key ("Up" :mod-1) 'select-previous-level)
-;; Up
-(define-main-key ("Up" :mod-1) 'circulate-group-up)
-(define-main-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
-(define-main-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
+(define-main-key ("Tab" :mod-1) 'select-next-child)
+(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
+(define-main-key ("Return" :mod-1) 'enter-group)
+(define-main-key ("Return" :mod-1 :shift) 'leave-group)
-;; Down
-(define-main-key ("Down" :mod-1) 'circulate-group-down)
-(define-main-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
-(define-main-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
+(define-main-key ("Home" :mod-1) 'switch-to-root-group)
+(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-group)
+(define-main-key ("Menu") 'toggle-show-root-group)
-;; Right
-(define-main-key ("Right" :mod-1) 'circulate-workspace-up)
-(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
-(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
+(define-main-key (#\b :mod-1) 'banish-pointer)
-;; Left
-(define-main-key ("Left" :mod-1) 'circulate-workspace-down)
-(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
-(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
+;;;; Escape
+(define-main-key ("Escape" :control :shift) 'delete-focus-window)
+(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window)
+(define-main-key ("Escape" :control) 'remove-focus-window)
+(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-child)
+(define-main-key (#\t :mod-1) 'second-key-mode)
+(define-main-key ("less" :control) 'second-key-mode)
-(defmacro define-main-focus-workspace-by-number (key number)
- "Define a main key to focus a workspace by its number"
- `(define-main-key ,key
- (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) ()
- ,(format nil "Focus workspace ~A" number)
- (circulate-workspace-by-number ,number))))
-(define-main-focus-workspace-by-number (#\1 :mod-1) 1)
-(define-main-focus-workspace-by-number (#\2 :mod-1) 2)
-(define-main-focus-workspace-by-number (#\3 :mod-1) 3)
-(define-main-focus-workspace-by-number (#\4 :mod-1) 4)
-(define-main-focus-workspace-by-number (#\5 :mod-1) 5)
-(define-main-focus-workspace-by-number (#\6 :mod-1) 6)
-(define-main-focus-workspace-by-number (#\7 :mod-1) 7)
-(define-main-focus-workspace-by-number (#\8 :mod-1) 8)
-(define-main-focus-workspace-by-number (#\9 :mod-1) 9)
-(define-main-focus-workspace-by-number (#\0 :mod-1) 10)
+;;(define-main-key ("a") (lambda ()
+;; (dbg 'key-a)
+;; (show-all-childs *root-group*)))
+;;
+;;(define-main-key ("b") (lambda ()
+;; (dbg 'key-b)
+;; (let* ((window (xlib:create-window :parent *root*
+;; :x 300
+;; :y 200
+;; :width 400
+;; :height 300
+;; :background (get-color "Black")
+;; :colormap (xlib:screen-default-colormap *screen*)
+;; :border-width 1
+;; :border (get-color "Red")
+;; :class :input-output
+;; :event-mask '(:exposure)))
+;; (gc (xlib:create-gcontext :drawable window
+;; :foreground (get-color "Green")
+;; :background (get-color "Red")
+;; :font *default-font*
+;; :line-style :solid)))
+;; (xlib:map-window window)
+;; (draw-line window gc 10 10 200 200)
+;; (xlib:display-finish-output *display*)
+;; (xlib:draw-glyphs window gc 10 10 (format nil "~A" 10))
+;; (dbg 'ici))))
+;;
+;;
+;;;;(define-main-key ("F1" :mod-1) 'help-on-clfswm)
+;;;;
+;;(defun quit-clfswm ()
+;; "Quit clfswm"
+;; (throw 'exit-main-loop nil))
+;;
+;;
+;;
+;;(define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
+;;
+;;(define-main-key (#\t :mod-1) 'second-key-mode)
+;;(define-main-key ("less" :control) 'second-key-mode)
+;;
+;;(define-main-key ("Tab" :mod-1) 'rotate-window-up)
+;;(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
+;;
+;;(define-main-key (#\b :mod-1) 'banish-pointer)
+;;(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
+;;
+;;;; Escape
+;;(define-main-key ("Escape" :control :shift) 'delete-current-window)
+;;(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
+;;(define-main-key ("Escape" :control) 'remove-current-window)
+;;(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
+;;
+;;
+;;;; Up
+;;(define-main-key ("Up" :mod-1) 'circulate-group-up)
+;;(define-main-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
+;;(define-main-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
+;;
+;;
+;;;; Down
+;;(define-main-key ("Down" :mod-1) 'circulate-group-down)
+;;(define-main-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
+;;(define-main-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
+;;
+;;
+;;;; Right
+;;(define-main-key ("Right" :mod-1) 'circulate-workspace-up)
+;;(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
+;;(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
+;;
+;;
+;;;; Left
+;;(define-main-key ("Left" :mod-1) 'circulate-workspace-down)
+;;(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
+;;(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
+;;
+;;
+;;
+;;(defmacro define-main-focus-workspace-by-number (key number)
+;; "Define a main key to focus a workspace by its number"
+;; `(define-main-key ,key
+;; (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) ()
+;; ,(format nil "Focus workspace ~A" number)
+;; (circulate-workspace-by-number ,number))))
+;;
+;;(define-main-focus-workspace-by-number (#\1 :mod-1) 1)
+;;(define-main-focus-workspace-by-number (#\2 :mod-1) 2)
+;;(define-main-focus-workspace-by-number (#\3 :mod-1) 3)
+;;(define-main-focus-workspace-by-number (#\4 :mod-1) 4)
+;;(define-main-focus-workspace-by-number (#\5 :mod-1) 5)
+;;(define-main-focus-workspace-by-number (#\6 :mod-1) 6)
+;;(define-main-focus-workspace-by-number (#\7 :mod-1) 7)
+;;(define-main-focus-workspace-by-number (#\8 :mod-1) 8)
+;;(define-main-focus-workspace-by-number (#\9 :mod-1) 9)
+;;(define-main-focus-workspace-by-number (#\0 :mod-1) 10)
--- /project/clfswm/cvsroot/clfswm/clfswm-info.lisp 2007/12/21 22:01:14 1.4
+++ /project/clfswm/cvsroot/clfswm/clfswm-info.lisp 2008/02/24 20:53:37 1.5
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Dec 21 23:00:04 2007
+;;; #Date#: Tue Feb 19 21:43:15 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Info function (see the end of this file for user definition
@@ -33,49 +33,49 @@
(defun leave-info-mode (info)
"Leave the info mode"
(declare (ignore info))
- (throw 'exit-info nil))
+ (throw 'exit-info-loop nil))
(defun mouse-leave-info-mode (root-x root-y info)
"Leave the info mode"
(declare (ignore root-x root-y info))
- (throw 'exit-info nil))
+ (throw 'exit-info-loop nil))
(defun draw-info-window (info)
- (clear-area (info-window info))
- (setf (gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+ (xlib:clear-area (info-window info))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
(loop for line in (info-list info)
- for y from 0 do
- (draw-image-glyphs (info-window info) (info-gc info)
- (- (info-ilw info) (info-x info))
- (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
- (format nil "~A" line))))
+ for y from 0 do
+ (xlib:draw-image-glyphs (info-window info) (info-gc info)
+ (- (info-ilw info) (info-x info))
+ (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
+ (format nil "~A" line))))
(defun draw-info-window-partial (info)
(let ((last-y (info-y info)))
- (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
- (draw-rectangle (info-window info) (info-gc info) 0 0
- (drawable-width (info-window info))
- (max (+ (- (info-y info)) (max-char-ascent (info-font info))) 0) t)
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info) 0 0
+ (xlib:drawable-width (info-window info))
+ (max (+ (- (info-y info)) (xlib:max-char-ascent (info-font info))) 0) t)
(loop for line in (info-list info)
- for y from 0 do
- (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
- (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
- (draw-rectangle (info-window info) (info-gc info)
- 0 (+ last-y (- (info-ilh info)) (max-char-descent (info-font info)))
- (drawable-width (info-window info)) (info-ilh info) t)
- (setf (gcontext-foreground (info-gc info)) (get-color *info-foreground*))
- (draw-image-glyphs (info-window info) (info-gc info)
- (- (info-ilw info) (info-x info))
- last-y
- (format nil "~A" line)))
- (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
- (draw-rectangle (info-window info) (info-gc info) 0 last-y
- (drawable-width (info-window info))
- (drawable-height (info-window info))
- t)))
+ for y from 0 do
+ (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info)
+ 0 (+ last-y (- (info-ilh info)) (xlib:max-char-descent (info-font info)))
+ (xlib:drawable-width (info-window info)) (info-ilh info) t)
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+ (xlib:draw-image-glyphs (info-window info) (info-gc info)
+ (- (info-ilw info) (info-x info))
+ last-y
+ (format nil "~A" line)))
+ (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
+ (xlib:draw-rectangle (info-window info) (info-gc info) 0 last-y
+ (xlib:drawable-width (info-window info))
+ (xlib:drawable-height (info-window info))
+ t)))
;;;,-----
@@ -129,7 +129,7 @@
(defun info-end-line (info)
"Move to last line"
(setf (info-x info) 0
- (info-y info) (- (* (length (info-list info)) (info-ilh info)) (drawable-height (info-window info))))
+ (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib:drawable-height (info-window info))))
(draw-info-window info)))
@@ -206,35 +206,35 @@
(when info-list
(let* ((pointer-grabbed (xgrab-pointer-p))
(keyboard-grabbed (xgrab-keyboard-p))
- (font (open-font *display* *info-font-string*))
- (ilw (max-char-width font))
- (ilh (+ (max-char-ascent font) (max-char-descent font) 1))
- (window (create-window :parent *root*
- :x x :y y
- :width (or width
- (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
- (- (screen-width *screen*) 2 x)))
- :height (or height
- (min (+ (* (length info-list) ilh) (/ ilh 2))
- (- (screen-height *screen*) 2 y)))
- :background (get-color *info-background*)
- :colormap (screen-default-colormap *screen*)
- :border-width 1
- :border (get-color *info-border*)
- :event-mask '(:exposure)))
- (gc (create-gcontext :drawable window
- :foreground (get-color *info-foreground*)
- :background (get-color *info-background*)
- :font font
- :line-style :solid))
+ (font (xlib:open-font *display* *info-font-string*))
+ (ilw (xlib:max-char-width font))
+ (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
+ (window (xlib:create-window :parent *root*
+ :x x :y y
+ :width (or width
+ (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
+ (- (xlib:screen-width *screen*) 2 x)))
+ :height (or height
+ (min (+ (* (length info-list) ilh) (/ ilh 2))
+ (- (xlib:screen-height *screen*) 2 y)))
+ :background (get-color *info-background*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :border-width 1
+ :border (get-color *info-border*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *info-foreground*)
+ :background (get-color *info-background*)
+ :font font
+ :line-style :solid))
(info (make-info :window window :gc gc :x 0 :y 0 :list info-list
- :font font :ilw ilw :ilh ilh)))
+ :font font :ilw ilw :ilh ilh)))
(labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
(funcall-key-from-code *info-keys* code state info))
(handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
(declare (ignore event-slots))
- (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
+ (unless (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
(:motion-notify () t))
(funcall-button-from-code *info-mouse-action* 'motion 0 root-x root-y #'first info)))
(handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
@@ -243,18 +243,12 @@
(handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
(funcall-button-from-code *info-mouse-action* code state root-x root-y #'third info))
- (handle-unmap-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
- (declare (ignore event-slots))
- (unless (and (not send-event-p)
- (not (window-equal window event-window)))
- (remove-window-in-all-workspace window)
- (draw-info-window info)))
- (handle-destroy-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
- (declare (ignore event-slots))
- (unless (or send-event-p
- (window-equal event-window window))
- (remove-window-in-all-workspace window)
- (draw-info-window info)))
+ (info-handle-unmap-notify (&rest event-slots)
+ (apply #'handle-unmap-notify event-slots)
+ (draw-info-window info))
+ (info-handle-destroy-notify (&rest event-slots)
+ (apply #'handle-destroy-notify event-slots)
+ (draw-info-window info))
(handle-events (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
(case event-key
@@ -263,33 +257,33 @@
(:button-release (apply #'handle-button-release event-slots) t)
(:motion-notify (apply #'handle-motion-notify event-slots) t)
(:map-request nil)
- (:unmap-notify (apply #'handle-unmap-notify event-slots) t)
- (:destroy-notify (apply #'handle-destroy-notify event-slots) t)
+ (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
+ (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
(:mapping-notify nil)
(:property-notify nil)
(:create-notify nil)
(:enter-notify nil)
(:exposure (draw-info-window info)))
t))
- (map-window window)
+ (xlib:map-window window)
(draw-info-window info)
(xgrab-pointer *root* 68 69)
(unless keyboard-grabbed
(xgrab-keyboard *root*))
(unwind-protect
- (catch 'exit-info
+ (catch 'exit-info-loop
(loop
- (display-finish-output *display*)
- (process-event *display* :handler #'handle-events)))
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-events)))
(if pointer-grabbed
(xgrab-pointer *root* 66 67)
(xungrab-pointer))
(unless keyboard-grabbed
(xungrab-keyboard))
- (free-gcontext gc)
- (destroy-window window)
- (close-font font)
- (show-all-group (current-workspace))
+ (xlib:free-gcontext gc)
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (show-all-childs)
(wait-no-key-or-button-press))))))
@@ -311,12 +305,12 @@
(lambda (&optional args)
(declare (ignore args))
(setf action function)
- (throw 'exit-info nil)))))
+ (throw 'exit-info-loop nil)))))
(info-mode (nreverse info-list) :x x :y y :width width :height height)
(dolist (item item-list)
(let ((key (first item)))
(undefine-info-key-fun (list key 0))))
- (when action
+ (when (fboundp action)
(funcall action))))
@@ -330,9 +324,9 @@
"Append spaces before Newline on each line"
(with-output-to-string (stream)
(loop for c across string do
- (when (equal c #\Newline)
- (princ " " stream))
- (princ c stream))))
+ (when (equal c #\Newline)
+ (princ " " stream))
+ (princ c stream))))
(defun show-key-binding (&rest hash-table-key)
@@ -346,7 +340,6 @@
(defun show-global-key-binding ()
"Show all key binding"
(show-key-binding *main-keys* *second-keys* *mouse-action*
- *pager-keys* *pager-mouse-action*
*info-keys* *info-mouse-action*))
(defun show-main-mode-key-binding ()
@@ -358,12 +351,6 @@
(show-key-binding *second-keys* *mouse-action*))
-(defun show-pager-key-binding ()
- "Show the pager mode key binding"
- (show-key-binding *pager-keys* *pager-mouse-action*))
-
-
-
(let ((days '("Lundi" "Mardi" "Mercredi" "Jeudi" "Vendredi" "Samedi" "Dimanche"))
(months '("Janvier" "Fevrier" "Mars" "Avril" "Mai" "Juin" "Juillet"
"Aout" "Septembre" "Octobre" "Novembre" "Decembre")))
@@ -380,18 +367,15 @@
(info-mode (list (date-string))))
-(defun show-date-pager ()
- "Show the current time and date"
- (pager-draw-display)
- (info-mode (list (date-string))))
+
(defun info-on-shell (program)
(let ((lines (do-shell program nil t)))
(info-mode (loop for line = (read-line lines nil nil)
- while line
- collect line))))
+ while line
+ collect line))))
(defun show-cpu-proc ()
@@ -456,11 +440,5 @@
-(defun help-on-pager ()
- "Open the help and info window"
- (info-mode-menu '((#\h show-global-key-binding)
- (#\b show-pager-key-binding)
- (#\t show-date-pager)))
- (pager-draw-display))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/01/03 22:15:48 1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/24 20:53:37 1.14
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 23:09:04 2008
+;;; #Date#: Sun Feb 24 21:38:37 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -29,7 +29,7 @@
;;; Minimal hook
-(defun call-hook (hook args)
+(defun call-hook (hook &optional args)
"Call a hook (a function, a symbol or a list of function)"
(typecase hook
(list (dolist (h hook)
@@ -37,265 +37,479 @@
(t (apply hook args))))
+;;; Group data manipulation functions
+(defun group-data-slot (group slot)
+ "Return the value associated to data slot"
+ (when (group-p group)
+ (second (assoc slot (group-data group)))))
+
+(defun set-group-data-slot (group slot value)
+ "Set the value associated to data slot"
+ (when (group-p group)
+ (with-slots (data) group
+ (setf data (remove (assoc slot data) data))
+ (push (list slot value) data))
+ value))
+
+(defsetf group-data-slot set-group-data-slot)
+
+
+
+(defgeneric group-p (group))
+(defmethod group-p ((group group))
+ (declare (ignore group))
+ t)
+(defmethod group-p (group)
+ (declare (ignore group))
+ nil)
+
+(defun create-group (&key name (x 0.1) (y 0.1) (w 0.8) (h 0.8) layout)
+ (let* ((window (xlib:create-window :parent *root*
+ :x 0
+ :y 0
+ :width 200
+ :height 200
+ :background (get-color "Black")
+ :colormap (xlib:screen-default-colormap *screen*)
+ :border-width 1
+ :border (get-color "Red")
+ :event-mask '(:exposure :button-press)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color "Green")
+ :background (get-color "Black")
+ :font *default-font*
+ :line-style :solid)))
+ (make-instance 'group :name name :x x :y y :w w :h h :window window :gc gc :layout layout)))
+
+
+(defun add-group (group father)
+ (push group (group-child father)))
+
+
+
+;; (with-all-childs (*root-group* child) (typecase child (xlib:window (print child)) (group (print (group-number child)))))
+(defmacro with-all-childs ((root child) &body body)
+ (let ((rec (gensym))
+ (sub-child (gensym)))
+ `(labels ((,rec (,child)
+ , at body
+ (when (group-p ,child)
+ (dolist (,sub-child (group-child ,child))
+ (,rec ,sub-child)))))
+ (,rec ,root))))
+
+
+;; (with-all-group (*root-group* group) (print (group-number group)))
+(defmacro with-all-groups ((root group) &body body)
+ (let ((rec (gensym))
+ (child (gensym)))
+ `(labels ((,rec (,group)
+ (when (group-p ,group)
+ , at body
+ (dolist (,child (group-child ,group))
+ (,rec ,child)))))
+ (,rec ,root))))
+
+
+;; (with-all-windows (*root-group* window) (print window))
+(defmacro with-all-windows ((root window) &body body)
+ (let ((rec (gensym))
+ (child (gensym)))
+ `(labels ((,rec (,window)
+ (when (xlib:window-p ,window)
+ , at body)
+ (when (group-p ,window)
+ (dolist (,child (group-child ,window))
+ (,rec ,child)))))
+ (,rec ,root))))
+
+
+
+;; (with-all-groups-windows (*root-group* child) (print child) (print (group-number child)))
+(defmacro with-all-windows-groups ((root child) body-window body-group)
+ (let ((rec (gensym))
+ (sub-child (gensym)))
+ `(labels ((,rec (,child)
+ (typecase ,child
+ (xlib:window ,body-window)
+ (group ,body-group
+ (dolist (,sub-child (group-child ,child))
+ (,rec ,sub-child))))))
+ (,rec ,root))))
-;;; CLFSWM internal functions
-(defun create-default-workspace (&optional number)
- (make-workspace :number (or number (incf *current-workspace-number*))))
-
-
-(defun get-group-size (group)
- (if (group-fullscreenp group)
- (destructuring-bind (x y width height) *fullscreen*
- (values x y width height))
- (values (group-x group)
- (group-y group)
- (group-width group)
- (group-height group))))
-
-
-(defun select-minimum-workspace ()
- "Rotate the workspace list until the smallest workspace is selected"
- (let ((min-number (loop for w in *workspace-list*
- minimize (workspace-number w))))
- (when min-number
- (loop while (and (workspace-p (first *workspace-list*))
- (/= (workspace-number (first *workspace-list*)) min-number))
- do (setf *workspace-list* (rotate-list *workspace-list*))))))
-
-
-
-(defun adapt-window-to-group (window group)
- (handler-case
- (when (and window group)
- (unhide-window window)
- (multiple-value-bind (x y width height)
- (get-group-size group)
- (case (window-type window)
- (:normal
- (setf/= (drawable-x window) x)
- (setf/= (drawable-y window) y)
- (setf/= (drawable-width window) width)
- (setf/= (drawable-height window) height)))))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c)))))
- ;;(dbg "Adapt error" c))))
+
+
+(defun find-child (to-find root)
+ "Find to-find in root or in its childs"
+ (with-all-childs (root child)
+ (when (equal child to-find)
+ (return-from find-child t))))
+
+
+
+(defun find-father-group (to-find &optional (root *root-group*))
+ "Return the father group of to-find"
+ (with-all-groups (root group)
+ (when (member to-find (group-child group))
+ (return-from find-father-group group))))
+
-(defun adapt-all-window-in-group (group)
- (when group
- (dolist (window (group-window-list group))
- (adapt-window-to-group window group))))
+(defun find-group-window (window &optional (root *root-group*))
+ "Return the group with the window window"
+ (with-all-groups (root group)
+ (when (xlib:window-equal window (group-window group))
+ (return-from find-group-window group))))
-(defun adapt-all-window-in-workspace (workspace)
- "Adapt all window to groups in workspace"
- (dolist (group (workspace-group-list workspace))
- (adapt-all-window-in-group group)))
-(defun add-window-in-group (window group)
- (when (and window group)
- (pushnew window (group-window-list group))
- (adapt-window-to-group window group)
- window))
+(defun get-all-windows (&optional (root *root-group*))
+ "Return all windows in root and in its childs"
+ (let ((acc nil))
+ (with-all-windows (root window)
+ (push window acc))
+ acc))
-(defun add-group-in-workspace (group workspace)
- (when group
- (pushnew group (workspace-group-list workspace))
- group))
+(defun get-hidden-windows ()
+ "Return all hiddens windows"
+ (let ((all-windows (get-all-windows))
+ (hidden-windows (remove-if-not #'window-hidden-p
+ (copy-list (xlib:query-tree *root*)))))
+ (set-difference hidden-windows all-windows)))
-(defun add-workspace (workspace)
- (when workspace
- (select-minimum-workspace)
- (setf *workspace-list* (anti-rotate-list (append *workspace-list* (list workspace))))
- (netwm-update-desktop-property)
- workspace))
-(defun remove-window-in-group (window group)
- (setf (group-window-list group)
- (remove window (group-window-list group))))
-(defun remove-window-in-workspace (window workspace)
- (dolist (group (workspace-group-list workspace))
- (remove-window-in-group window group)))
-(defun remove-window-in-all-workspace (window)
- (dolist (workspace *workspace-list*)
- (remove-window-in-workspace window workspace))
- (netwm-remove-in-client-list window))
+(defun display-group-info (group)
+ (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
+ (with-slots (name number gc window child) group
+ (when (equal group *current-root*)
+ (xlib:clear-area window))
+ (xlib:with-gcontext (gc :foreground (get-color (if (and (equal group *current-root*)
+ (equal group *current-child*))
+ "Red" "Green")))
+ (xlib:draw-glyphs window gc 5 dy
+ (format nil "Group: ~A~A" number
+ (if name (format nil " - ~A" name) "")))
+ (let ((pos dy))
+ (when (equal group *current-root*)
+ (xlib:draw-image-glyphs window gc 5 (incf pos dy)
+ (format nil "~A hidden windows " (length (get-hidden-windows))))
+ (when *child-selection*
+ (xlib:draw-image-glyphs window gc 5 (incf pos dy)
+ (with-output-to-string (str)
+ (format str "Selection: ")
+ (dolist (child *child-selection*)
+ (typecase child
+ (xlib:window (format str "~A " (xlib:wm-name child)))
+ (group (format str "group:~A[~A] " (group-number child)
+ (aif (group-name child) it "")))))
+ (format str " ")))))
+ (dolist (ch child)
+ (when (xlib:window-p ch)
+ (xlib:draw-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))))))
-(defun remove-group-in-workspace (group workspace)
- (setf (workspace-group-list workspace)
- (remove group (workspace-group-list workspace))))
-(defun remove-group-in-all-workspace (group)
- (dolist (workspace *workspace-list*)
- (remove-group-in-workspace group workspace)))
-(defun remove-workspace (workspace)
- (setf *workspace-list* (remove workspace *workspace-list*))
- (netwm-update-desktop-property))
-(defun current-workspace ()
- (if (consp *workspace-list*)
- (first *workspace-list*)
- (add-workspace (create-default-workspace))))
-(defun current-group ()
- (let ((current-workspace (current-workspace)))
- (when current-workspace
- (let ((group-list (workspace-group-list current-workspace)))
- (if (consp group-list)
- (first group-list)
- (add-group-in-workspace (copy-group *default-group*) current-workspace))))))
-(defun current-window ()
- (let ((current-group (current-group)))
- (when current-group
- (let ((window-list (group-window-list current-group)))
- (when (consp window-list)
- (first window-list))))))
+(defun get-father-layout (child father)
+ (if (group-p father)
+ (aif (group-layout father)
+ (funcall it child father)
+ (no-layout child father))
+ (get-fullscreen-size)))
+(defgeneric adapt-child-to-father (child father))
+(defmethod adapt-child-to-father ((window xlib:window) father)
+ (with-xlib-protect
+ (multiple-value-bind (nx ny nw nh)
+ (get-father-layout window father)
+ (setf (xlib:drawable-x window) nx
+ (xlib:drawable-y window) ny
+ (xlib:drawable-width window) nw
+ (xlib:drawable-height window) nh))))
+(defmethod adapt-child-to-father ((group group) father)
+ (with-xlib-protect
+ (multiple-value-bind (nx ny nw nh)
+ (get-father-layout group father)
+ (with-slots (rx ry rw rh window) group
+ (setf rx nx ry ny rw nw rh nh)
+ (setf (xlib:drawable-x window) rx
+ (xlib:drawable-y window) ry
+ (xlib:drawable-width window) rw
+ (xlib:drawable-height window) rh)))))
+
+
-(defun hide-group (root group)
- (multiple-value-bind (x y width height)
- (get-group-size group)
- (clear-area root :x (1- x) :y (1- y) :width (+ width 2) :height (+ height 2))))
+(defgeneric show-child (child father))
+(defgeneric hide-child (child))
+(defmethod show-child ((group group) father)
+ (with-xlib-protect
+ (with-slots (window) group
+ (adapt-child-to-father group father)
+ (when (or *show-root-group-p* (not (equal group *current-root*)))
+ (setf (xlib:window-background window) (get-color "Black"))
+ (xlib:map-window window)
+ (raise-window window)
+ (display-group-info group)))))
-(defun show-group (root gc group)
- (when (and gc group)
- (handler-case
- (multiple-value-bind (x y width height)
- (get-group-size group)
- (setf (gcontext-foreground gc)
- (get-color (if (eql group (current-group))
- *color-selected*
- *color-unselected*)))
- (draw-rectangle root gc (1- x) (1- y) (1+ width) (1+ height))
- (draw-line root gc x y (+ x width) (+ y height))
- (draw-line root gc x (+ y height) (+ x width) y))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
+(defmethod hide-child ((group group))
+ (with-xlib-protect
+ (with-slots (window) group
+ (xlib:unmap-window window))))
+(defmethod show-child ((window xlib:window) father)
+ (with-xlib-protect
+ (when (eql (window-type window) :normal)
+ (adapt-child-to-father window father))
+ (xlib:map-window window)
+ (raise-window window)))
-(defun show-all-group (workspace &optional (root *root*) (gc *root-gc*) (clear-all :hide-each))
- "Show all groups in workspace
-clear-all: nil=do not clear; t=clear all root window; :hide-each=clear each group before redrawing"
- (handler-case
- (progn
- (when clear-all
- (clear-area root))
- (dolist (group (reverse (workspace-group-list workspace)))
- (when (eql clear-all :hide-each)
- (hide-group root group))
- (show-group root gc group)))
- ((or match-error window-error drawable-error) (c)
[460 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp 2008/01/03 20:31:24 1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp 2008/02/24 20:53:37 1.6
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 19:24:00 2008
+;;; #Date#: Tue Feb 12 19:23:14 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Keys functions definition
@@ -47,20 +47,20 @@
(undefine-name (create-symbol "undefine-" name "-key"))
(undefine-multi-name (create-symbol "undefine-" name "-multi-keys")))
`(progn
- (defun ,name-key-fun (key function &optional keystring)
- "Define a new key, a key is '(char '(modifier list))"
- (setf (gethash key ,hashtable) (list function keystring)))
+ (defun ,name-key-fun (key function &optional keystring)
+ "Define a new key, a key is '(char '(modifier list))"
+ (setf (gethash key ,hashtable) (list function keystring)))
- (defmacro ,name-key ((key &rest modifiers) function &optional keystring)
- `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function ,keystring))
+ (defmacro ,name-key ((key &rest modifiers) function &optional keystring)
+ `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function ,keystring))
- (defmacro ,undefine-name ((key &rest modifiers))
- `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
+ (defmacro ,undefine-name ((key &rest modifiers))
+ `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
- (defmacro ,undefine-multi-name (&rest keys)
- `(progn
- ,@(loop for k in keys
- collect `(,',undefine-name ,k)))))))
+ (defmacro ,undefine-multi-name (&rest keys)
+ `(progn
+ ,@(loop for k in keys
+ collect `(,',undefine-name ,k)))))))
(defmacro define-define-mouse (name hashtable)
@@ -68,15 +68,15 @@
(name-mouse (create-symbol "define-" name))
(undefine-name (create-symbol "undefine-" name)))
`(progn
- (defun ,name-mouse-fun (button function-press &optional keystring function-release)
- "Define a new mouse button action, a button is '(button number '(modifier list))"
- (setf (gethash button ,hashtable) (list function-press keystring function-release)))
+ (defun ,name-mouse-fun (button function-press &optional keystring function-release)
+ "Define a new mouse button action, a button is '(button number '(modifier list))"
+ (setf (gethash button ,hashtable) (list function-press keystring function-release)))
- (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release keystring)
- `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,keystring ,function-release))
+ (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release keystring)
+ `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,keystring ,function-release))
- (defmacro ,undefine-name ((key &rest modifiers))
- `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
+ (defmacro ,undefine-name ((key &rest modifiers))
+ `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
@@ -105,27 +105,77 @@
(defmacro define-ungrab/grab (name function hashtable)
`(defun ,name ()
- (maphash #'(lambda (k v)
- (declare (ignore v))
- (when (consp k)
- (handler-case
- (let* ((key (first k))
- (keycode (typecase key
- (character (char->keycode key))
- (number key)
- (string (let ((keysym (keysym-name->keysym key)))
- (and keysym (keysym->keycodes *display* keysym)))))))
- (if keycode
- (,function *root* keycode :modifiers (second k))
- (format t "~&Grabbing error: Can't find key '~A'~%" key)))
- (error (c)
- ;;(declare (ignore c))
- (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
- (force-output)))
- ,hashtable)))
+ (maphash #'(lambda (k v)
+ (declare (ignore v))
+ (when (consp k)
+ (handler-case
+ (let* ((key (first k))
+ (keycode (typecase key
+ (character (char->keycode key))
+ (number key)
+ (string (let ((keysym (keysym-name->keysym key)))
+ (and keysym (xlib:keysym->keycodes *display* keysym)))))))
+ (if keycode
+ (,function *root* keycode :modifiers (second k))
+ (format t "~&Grabbing error: Can't find key '~A'~%" key)))
+ (error (c)
+ ;;(declare (ignore c))
+ (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
+ (force-output)))
+ ,hashtable)))
+
+(define-ungrab/grab grab-main-keys xlib:grab-key *main-keys*)
+(define-ungrab/grab ungrab-main-keys xlib:ungrab-key *main-keys*)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defun funcall-key-from-code (hash-table-key code state &optional args)
+ (labels ((funcall-from (key)
+ (multiple-value-bind (function foundp)
+ (gethash (list key state) hash-table-key)
+ (when (and foundp (first function))
+ (if args
+ (funcall (first function) args)
+ (funcall (first function)))
+ t)))
+ (from-code ()
+ (funcall-from code))
+ (from-char ()
+ (let ((char (keycode->char code state)))
+ (funcall-from char)))
+ (from-string ()
+ (let ((string (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+ (funcall-from string))))
+ (cond ((from-code))
+ ((from-char))
+ ((from-string)))))
+
+
+
+(defun funcall-button-from-code (hash-table-key code state root-x root-y
+ &optional (action #'first) args)
+ "Action: first=press third=release"
+ (let ((state (modifiers->state (set-difference (state->modifiers state)
+ '(:button-1 :button-2 :button-3 :button-4 :button-5)))))
+ (multiple-value-bind (function foundp)
+ (gethash (list code state) hash-table-key)
+ (if (and foundp (funcall action function))
+ (if args
+ (funcall (funcall action function) root-x root-y args)
+ (funcall (funcall action function) root-x root-y))
+ t))))
-(define-ungrab/grab grab-main-keys grab-key *main-keys*)
-(define-ungrab/grab ungrab-main-keys ungrab-key *main-keys*)
@@ -145,8 +195,8 @@
(produce-keys (hk)
`("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
(tr ("th align=\"right\" width=\"10%\"" "Modifiers")
- ("th align=\"center\" width=\"10%\"" "Key/Button")
- ("th align=\"left\"" "Function"))
+ ("th align=\"center\" width=\"10%\"" "Key/Button")
+ ("th align=\"left\"" "Function"))
,@(let ((acc nil))
(maphash #'(lambda (k v)
(when (consp k)
--- /project/clfswm/cvsroot/clfswm/clfswm-pack.lisp 2007/12/29 15:20:10 1.4
+++ /project/clfswm/cvsroot/clfswm/clfswm-pack.lisp 2008/02/24 20:53:37 1.5
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Dec 28 22:13:42 2007
+;;; #Date#: Tue Feb 12 14:02:45 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Tile, pack and fill functions
@@ -34,14 +34,14 @@
"Tile a workspace vertically"
(let* ((len (max (length (workspace-group-list workspace)) 1))
(n (ceiling (sqrt len)))
- (dx (/ (screen-width *screen*) n))
- (dy (/ (screen-height *screen*) (ceiling (/ len n)))))
+ (dx (/ (xlib:screen-width *screen*) n))
+ (dy (/ (xlib:screen-height *screen*) (ceiling (/ len n)))))
(loop for group in (workspace-group-list workspace)
- for i from 0 do
- (setf (group-x group) (1+ (truncate (* (mod i n) dx)))
- (group-y group) (1+ (truncate (* (truncate (/ i n)) dy)))
- (group-width group) (- (truncate dx) 2)
- (group-height group) (- (truncate dy) 2)))))
+ for i from 0 do
+ (setf (group-x group) (1+ (truncate (* (mod i n) dx)))
+ (group-y group) (1+ (truncate (* (truncate (/ i n)) dy)))
+ (group-width group) (- (truncate dx) 2)
+ (group-height group) (- (truncate dy) 2)))))
(defun tile-current-workspace-vertically ()
@@ -56,14 +56,14 @@
"Tile a workspace horizontally"
(let* ((len (max (length (workspace-group-list workspace)) 1))
(n (ceiling (sqrt len)))
- (dx (/ (screen-width *screen*) (ceiling (/ len n))))
- (dy (/ (screen-height *screen*) n)))
+ (dx (/ (xlib:screen-width *screen*) (ceiling (/ len n))))
+ (dy (/ (xlib:screen-height *screen*) n)))
(loop for group in (workspace-group-list workspace)
- for i from 0 do
- (setf (group-x group) (1+ (truncate (* (truncate (/ i n)) dx)))
- (group-y group) (1+ (truncate (* (mod i n) dy)))
- (group-width group) (- (truncate dx) 2)
- (group-height group) (- (truncate dy) 2)))))
+ for i from 0 do
+ (setf (group-x group) (1+ (truncate (* (truncate (/ i n)) dx)))
+ (group-y group) (1+ (truncate (* (mod i n) dy)))
+ (group-width group) (- (truncate dx) 2)
+ (group-height group) (- (truncate dy) 2)))))
(defun tile-current-workspace-horizontally ()
@@ -80,19 +80,19 @@
(if (<= len 1)
(setf (group-x group) 0
(group-y group) 0
- (group-width group) (screen-width *screen*)
- (group-height group) (screen-height *screen*))
- (let ((dy (/ (screen-height *screen*) (1- len))))
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dy (/ (xlib:screen-height *screen*) (1- len))))
(setf (group-x group) 1
(group-y group) 1
- (group-width group) (- (screen-width *screen*) *tile-border-size* 1)
- (group-height group) (- (screen-height *screen*) 1))
+ (group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+ (group-height group) (- (xlib:screen-height *screen*) 1))
(loop :for i :from 0
- :for g :in (rest (workspace-group-list workspace))
- :do (setf (group-x g) (- (screen-width *screen*) *tile-border-size* -1)
- (group-y g) (truncate (* i dy))
- (group-width g) (- *tile-border-size* 2)
- (group-height g) (truncate (- dy 1))))))))
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (- (xlib:screen-width *screen*) *tile-border-size* -1)
+ (group-y g) (truncate (* i dy))
+ (group-width g) (- *tile-border-size* 2)
+ (group-height g) (truncate (- dy 1))))))))
(defun tile-workspace-left (workspace)
"Tile workspace with the current window on the right and others on the left"
@@ -101,19 +101,19 @@
(if (<= len 1)
(setf (group-x group) 0
(group-y group) 0
- (group-width group) (screen-width *screen*)
- (group-height group) (screen-height *screen*))
- (let ((dy (/ (screen-height *screen*) (1- len))))
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dy (/ (xlib:screen-height *screen*) (1- len))))
(setf (group-x group) *tile-border-size*
(group-y group) 1
- (group-width group) (- (screen-width *screen*) *tile-border-size* 1)
- (group-height group) (- (screen-height *screen*) 1))
+ (group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+ (group-height group) (- (xlib:screen-height *screen*) 1))
(loop :for i :from 0
- :for g :in (rest (workspace-group-list workspace))
- :do (setf (group-x g) 0
- (group-y g) (truncate (* i dy))
- (group-width g) (- *tile-border-size* 2)
- (group-height g) (truncate (- dy 1))))))))
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) 0
+ (group-y g) (truncate (* i dy))
+ (group-width g) (- *tile-border-size* 2)
+ (group-height g) (truncate (- dy 1))))))))
(defun tile-workspace-top (workspace)
@@ -123,19 +123,19 @@
(if (<= len 1)
(setf (group-x group) 0
(group-y group) 0
- (group-width group) (screen-width *screen*)
- (group-height group) (screen-height *screen*))
- (let ((dx (/ (screen-width *screen*) (1- len))))
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dx (/ (xlib:screen-width *screen*) (1- len))))
(setf (group-x group) 1
(group-y group) *tile-border-size*
- (group-width group) (- (screen-width *screen*) 1)
- (group-height group) (- (screen-height *screen*) *tile-border-size* 1))
+ (group-width group) (- (xlib:screen-width *screen*) 1)
+ (group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
(loop :for i :from 0
- :for g :in (rest (workspace-group-list workspace))
- :do (setf (group-x g) (truncate (* i dx))
- (group-y g) 0
- (group-width g) (truncate (- dx 1))
- (group-height g) (- *tile-border-size* 2)))))))
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (truncate (* i dx))
+ (group-y g) 0
+ (group-width g) (truncate (- dx 1))
+ (group-height g) (- *tile-border-size* 2)))))))
(defun tile-workspace-bottom (workspace)
"Tile workspace with the current window on the top and others on the bottom"
@@ -144,19 +144,19 @@
(if (<= len 1)
(setf (group-x group) 0
(group-y group) 0
- (group-width group) (screen-width *screen*)
- (group-height group) (screen-height *screen*))
- (let ((dx (/ (screen-width *screen*) (1- len))))
+ (group-width group) (xlib:screen-width *screen*)
+ (group-height group) (xlib:screen-height *screen*))
+ (let ((dx (/ (xlib:screen-width *screen*) (1- len))))
(setf (group-x group) 1
(group-y group) 1
- (group-width group) (- (screen-width *screen*) 1)
- (group-height group) (- (screen-height *screen*) *tile-border-size* 1))
+ (group-width group) (- (xlib:screen-width *screen*) 1)
+ (group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
(loop :for i :from 0
- :for g :in (rest (workspace-group-list workspace))
- :do (setf (group-x g) (truncate (* i dx))
- (group-y g) (- (screen-height *screen*) *tile-border-size* -1)
- (group-width g) (truncate (- dx 1))
- (group-height g) (- *tile-border-size* 2)))))))
+ :for g :in (rest (workspace-group-list workspace))
+ :do (setf (group-x g) (truncate (* i dx))
+ (group-y g) (- (xlib:screen-height *screen*) *tile-border-size* -1)
+ (group-width g) (truncate (- dx 1))
+ (group-height g) (- *tile-border-size* 2)))))))
(defun tile-current-workspace-to ()
@@ -170,11 +170,11 @@
(let ((method (loop :for m = (intern (string-upcase
(query-string "Workspace tiling method (R)ight, (L)eft, (T)op, (B)ottom:"))
:keyword)
- :when (member m '(:r :l :t :b)) :return m))
+ :when (member m '(:r :l :t :b)) :return m))
(size (loop :for s = (parse-integer (query-string "Workspace tiling border size"
(format nil "~A" *tile-border-size*))
:junk-allowed t)
- :when (numberp s) :return s)))
+ :when (numberp s) :return s)))
(setf *tile-workspace-function* (case method
(:r 'tile-workspace-right)
(:l 'tile-workspace-left)
@@ -206,7 +206,7 @@
y-found))
(defun find-edge-down (current-group workspace)
- (let ((y-found (screen-height *screen*)))
+ (let ((y-found (xlib:screen-height *screen*)))
(dolist (group (workspace-group-list workspace))
(when (and (not (equal group current-group))
(>= (group-y group) (group-y2 current-group))
@@ -216,7 +216,7 @@
y-found))
(defun find-edge-right (current-group workspace)
- (let ((x-found (screen-width *screen*)))
+ (let ((x-found (xlib:screen-width *screen*)))
(dolist (group (workspace-group-list workspace))
(when (and (not (equal group current-group))
(>= (group-x group) (group-x2 current-group))
@@ -294,8 +294,8 @@
(defun center-group (group)
"Center group"
- (setf (group-x group) (truncate (/ (- (screen-width *screen*) (group-width group)) 2))
- (group-y group) (truncate (/ (- (screen-height *screen*) (group-height group)) 2))))
+ (setf (group-x group) (truncate (/ (- (xlib:screen-width *screen*) (group-width group)) 2))
+ (group-y group) (truncate (/ (- (xlib:screen-height *screen*) (group-height group)) 2))))
(defun center-current-group ()
"Center the current group"
@@ -375,11 +375,11 @@
(defun resize-minimal-group (group)
"Resize down a group to its minimal size"
(loop while (> (group-width group) 100) do
- (setf (group-x group) (+ (group-x group) 10)
- (group-width group) (max (- (group-width group) 20))))
+ (setf (group-x group) (+ (group-x group) 10)
+ (group-width group) (max (- (group-width group) 20))))
(loop while (> (group-height group) 100) do
- (setf (group-y group) (+ (group-y group) 10)
- (group-height group) (max (- (group-height group) 20)))))
+ (setf (group-y group) (+ (group-y group) 10)
+ (group-height group) (max (- (group-height group) 20)))))
--- /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp 2008/01/03 20:31:24 1.10
+++ /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp 2008/02/24 20:53:37 1.11
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 00:14:39 2008
+;;; #Date#: Fri Feb 22 21:38:53 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Second mode functions
@@ -34,24 +34,35 @@
(defparameter *second-mode-program* nil
"Execute the program string if not nil")
+
+;;(defun draw-second-mode-window ()
+;; (xlib:clear-area *sm-window*)
+;; (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A"
+;; (workspace-number (current-workspace))
+;; (if *arrow-action* *arrow-action* "")
+;; (if *motion-action* *motion-action* "")
+;; (cond ((numberp *open-next-window-in-new-workspace*)
+;; (format nil ">W:~A" *open-next-window-in-new-workspace*))
+;; (*open-next-window-in-new-workspace* ">W")
+;; (t ""))
+;; (cond ((equal *open-next-window-in-new-group* :once) ">G")
+;; (*open-next-window-in-new-group* ">G+")
+;; (t ""))))
+;; (len (length text)))
+;; (xlib:draw-image-glyphs *sm-window* *sm-gc*
+;; (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+;; (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2))
+;; text)))
+
+
(defun draw-second-mode-window ()
- (clear-area *sm-window*)
- (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A"
- (workspace-number (current-workspace))
- (if *arrow-action* *arrow-action* "")
- (if *motion-action* *motion-action* "")
- (cond ((numberp *open-next-window-in-new-workspace*)
- (format nil ">W:~A" *open-next-window-in-new-workspace*))
- (*open-next-window-in-new-workspace* ">W")
- (t ""))
- (cond ((equal *open-next-window-in-new-group* :once) ">G")
- (*open-next-window-in-new-group* ">G+")
- (t ""))))
+ (xlib:clear-area *sm-window*)
+ (let* ((text (format nil "Second mode"))
(len (length text)))
- (draw-image-glyphs *sm-window* *sm-gc*
- (truncate (/ (- *sm-width* (* (max-char-width *sm-font*) len)) 2))
- (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2))
- text)))
+ (xlib:draw-image-glyphs *sm-window* *sm-gc*
+ (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+ (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
+ text)))
@@ -63,8 +74,8 @@
(draw-second-mode-window))
(defun sm-handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots))
- (focus-group-under-mouse root-x root-y)
+ (declare (ignore event-slots root-x root-y))
+ ;; (focus-group-under-mouse root-x root-y)
(draw-second-mode-window))
(defun sm-handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
@@ -111,7 +122,7 @@
;;(defun sm-handle-property-notify (&rest event-slots &key window &allow-other-keys)
-;; ;;(dbg (wm-name window))
+;; ;;(dbg (xlib:wm-name window))
;; (draw-second-mode-window))
@@ -135,24 +146,22 @@
(defun sm-handle-event (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
;;(dbg event-key)
- (handler-case
- (case event-key
- (:button-press (call-hook *sm-button-press-hook* event-slots))
- (:button-release (call-hook *sm-button-release-hook* event-slots))
- (:motion-notify (call-hook *sm-motion-notify-hook* event-slots))
- (:key-press (call-hook *sm-key-press-hook* event-slots))
- (:configure-request (call-hook *sm-configure-request-hook* event-slots))
- (:configure-notify (call-hook *sm-configure-notify-hook* event-slots))
- (:map-request (call-hook *sm-map-request-hook* event-slots))
- (:unmap-notify (call-hook *sm-unmap-notify-hook* event-slots))
- (:destroy-notify (call-hook *sm-destroy-notify-hook* event-slots))
- (:mapping-notify (call-hook *sm-mapping-notify-hook* event-slots))
- (:property-notify (call-hook *sm-property-notify-hook* event-slots))
- (:create-notify (call-hook *sm-create-notify-hook* event-slots))
- (:enter-notify (call-hook *sm-enter-notify-hook* event-slots))
- (:exposure (call-hook *sm-exposure-hook* event-slots)))
- ((or drawable-error window-error) (c)
- (declare (ignore c))))
+ (with-xlib-protect
+ (case event-key
+ (:button-press (call-hook *sm-button-press-hook* event-slots))
+ (:button-release (call-hook *sm-button-release-hook* event-slots))
+ (:motion-notify (call-hook *sm-motion-notify-hook* event-slots))
+ (:key-press (call-hook *sm-key-press-hook* event-slots))
+ (:configure-request (call-hook *sm-configure-request-hook* event-slots))
+ (:configure-notify (call-hook *sm-configure-notify-hook* event-slots))
+ (:map-request (call-hook *sm-map-request-hook* event-slots))
+ (:unmap-notify (call-hook *sm-unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *sm-destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *sm-mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *sm-property-notify-hook* event-slots))
+ (:create-notify (call-hook *sm-create-notify-hook* event-slots))
+ (:enter-notify (call-hook *sm-enter-notify-hook* event-slots))
+ (:exposure (call-hook *sm-exposure-hook* event-slots))))
;;(dbg "Ignore handle event" c event-slots)))
t)
@@ -161,23 +170,22 @@
(defun second-key-mode ()
"Switch to editing mode"
;;(dbg "Second key ignore" c)))))
- (minimize-group (current-group))
- (setf *sm-window* (create-window :parent *root*
- :x (truncate (/ (- (screen-width *screen*) *sm-width*) 2))
- :y 0
- :width *sm-width* :height *sm-height*
- :background (get-color *sm-background-color*)
- :border-width 1
- :border (get-color *sm-border-color*)
- :colormap (screen-default-colormap *screen*)
- :event-mask '(:exposure))
- *sm-font* (open-font *display* *sm-font-string*)
- *sm-gc* (create-gcontext :drawable *sm-window*
- :foreground (get-color *sm-foreground-color*)
- :background (get-color *sm-background-color*)
- :font *sm-font*
- :line-style :solid))
- (map-window *sm-window*)
+ (setf *sm-window* (xlib:create-window :parent *root*
+ :x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
+ :y 0
+ :width *sm-width* :height *sm-height*
+ :background (get-color *sm-background-color*)
+ :border-width 1
+ :border (get-color *sm-border-color*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure))
+ *sm-font* (xlib:open-font *display* *sm-font-string*)
+ *sm-gc* (xlib:create-gcontext :drawable *sm-window*
+ :foreground (get-color *sm-foreground-color*)
+ :background (get-color *sm-background-color*)
+ :font *sm-font*
+ :line-style :solid))
+ (xlib:map-window *sm-window*)
(draw-second-mode-window)
(no-focus)
(ungrab-main-keys)
@@ -187,18 +195,16 @@
(catch 'exit-second-loop
(loop
(raise-window *sm-window*)
- (display-finish-output *display*)
- (process-event *display* :handler #'sm-handle-event)
- (display-finish-output *display*)))
- (free-gcontext *sm-gc*)
- (close-font *sm-font*)
- (destroy-window *sm-window*)
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'sm-handle-event)
+ (xlib:display-finish-output *display*)))
+ (xlib:free-gcontext *sm-gc*)
+ (xlib:close-font *sm-font*)
+ (xlib:destroy-window *sm-window*)
(xungrab-keyboard)
(xungrab-pointer)
- (grab-main-keys))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace))
+ (grab-main-keys)
+ (show-all-childs))
(wait-no-key-or-button-press)
(when *second-mode-program*
(do-shell *second-mode-program*)
@@ -206,229 +212,11 @@
+(defun leave-second-mode ()
+ "Leave second mode"
+ (banish-pointer)
+ (throw 'exit-second-loop nil))
+
-;;;;; Alternative - Second mode with dashed screen
-;;(let ((num 5)
-;; (line-color "Green"))
-;; (defun draw-second-mode-window (window gc)
-;; (show-all-windows-in-workspace (current-workspace))
-;; (sleep 0.1)
-;; (display-finish-output *display*)
-;; (raise-window window)
-;; (setf (gcontext-foreground gc) (get-color line-color)
-;; (gcontext-line-style gc) :dash)
-;; (let ((dx (/ (drawable-width window) num))
-;; (dy (/ (drawable-height window) num)))
-;; (loop for i from 1 below num do
-;; (draw-line window gc (truncate (* i dx)) 0 0 (truncate (* i dy)))
-;; (draw-line window gc (truncate (* i dx)) (drawable-height window) (drawable-width window) (truncate (* i dy)))
-;; (draw-line window gc (truncate (* i dx)) 0 (drawable-width window) (truncate (* (- num i) dy)))
-;; (draw-line window gc (truncate (* (- num i) dx)) (drawable-height window) 0 (truncate (* i dy)))))
-;; (draw-line window gc 0 (drawable-height window) (drawable-width window) 0)
-;; (draw-line window gc 0 0 (drawable-width window) (drawable-height window))
-;; (setf (gcontext-line-style gc) :solid)
-;; (show-all-group (current-workspace) window gc)
-;; (no-focus)))
-;;
-;;(defmacro with-draw-second-mode-window ((hide show) &body body)
-;; (cond ((and hide show) `(progn
-;; (hide-window sm-window)
-;; , at body
-;; (draw-second-mode-window sm-window sm-gc)
-;; (display-force-output *display*)))
-;; (hide `(progn
-;; (hide-window sm-window)
-;; , at body
-;; (display-force-output *display*)))
-;; (show `(progn
-;; , at body
-;; (draw-second-mode-window sm-window sm-gc)
-;; (display-force-output *display*)))
-;; (t `(progn
-;; , at body
-;; (display-force-output *display*)))))
-;;
-;;
-;;(defun second-key-mode ()
-;; "Switch to editing mode"
-;; (let* ((sm-window (create-window :parent *root* :x 0 :y 0
-;; :width (screen-width *screen*) :height (screen-height *screen*)
-;; :colormap (screen-default-colormap *screen*)
-;; :event-mask '()))
-;; (sm-gc (create-gcontext :drawable sm-window
-;; :foreground (get-color "Red")
-;; :background (get-color "Black")
-;; :line-style :solid)))
-;; (labels ((handle-key-press (&rest event-slots &key root code state &allow-other-keys)
-;; (declare (ignore event-slots root))
-;; (funcall-key-from-code *second-keys* code state))
-;; (sm-handle-enter-notify (&rest event-slots &key window root-x root-y &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (unless (or (window-equal sm-window window)
-;; (window-equal window *root*))
-;; (with-draw-second-mode-window (t t)
-;; (focus-group-under-mouse root-x root-y))))
-;; (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
-;; (:motion-notify () t))
-;; (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)
-;; (show-all-group (current-workspace) sm-window sm-gc)
-;; (no-focus)))
-;; (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (funcall-button-from-code *mouse-action* code state root-x root-y #'first))
-;; (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (funcall-button-from-code *mouse-action* code state root-x root-y #'third))
-;; (sm-handle-configure-request (&rest event-slots &key window &allow-other-keys)
-;; (unless (window-equal sm-window window)
-;; (with-draw-second-mode-window (t t)
-;; (apply #'handle-configure-request event-slots))))
-;; (sm-handle-map-request (&rest event-slots &key window &allow-other-keys)
-;; (unless (window-equal sm-window window)
-;; (with-draw-second-mode-window (t t)
-;; (apply #'handle-map-request event-slots))))
-;; (sm-handle-unmap-notify (&rest event-slots &key window &allow-other-keys)
-;; (unless (window-equal sm-window window)
-;; (with-draw-second-mode-window (t t)
-;; (apply #'handle-unmap-notify event-slots))))
-;; (sm-handle-destroy-notify (&rest event-slots &key window &allow-other-keys)
-;; (unless (window-equal sm-window window)
-;; (with-draw-second-mode-window (t t)
-;; (apply #'handle-destroy-notify event-slots))))
-;; (handle-event (&rest event-slots &key display event-key &allow-other-keys)
-;; (declare (ignore display))
-;; (handler-case
-;; (case event-key
-;; (:key-press (with-draw-second-mode-window (t t)
-;; (apply #'handle-key-press event-slots)))
-;; (:enter-notify nil)
-;; (:motion-notify (apply #'handle-motion-notify event-slots))
-;; (:button-press (with-draw-second-mode-window (t nil)
-;; (apply #'handle-button-press event-slots)))
-;; (:button-release (with-draw-second-mode-window (nil t)
-;; (apply #'handle-button-release event-slots)))
-;; (:configure-request (apply #'sm-handle-configure-request event-slots))
-;; (:map-request (apply #'sm-handle-map-request event-slots))
-;; (:unmap-notify (apply #'sm-handle-unmap-notify event-slots))
-;; (:destroy-notify (apply #'sm-handle-destroy-notify event-slots))
-;; (:mapping-notify nil)
-;; (:property-notify nil)
-;; (:create-notify nil))
-;; ((or drawable-error window-error) (c)
-;; (declare (ignore c))))
-;; t))
-;; ;;(dbg "Second key ignore" c)))))
-;; (minimize-group (current-group))
-;; (map-window sm-window)
-;; (raise-window sm-window)
-;; (draw-second-mode-window sm-window sm-gc)
-;; (no-focus)
-;; (ungrab-main-keys)
-;; (xgrab-keyboard *root*)
-;; (xgrab-pointer *root* 66 67)
-;; (unwind-protect
-;; (catch 'exit-second-loop
-;; (loop
-;; (process-event *display* :handler #'handle-event)
-;; (display-finish-output *display*)))
-;; (free-gcontext sm-gc)
-;; (destroy-window sm-window)
-;; (xungrab-keyboard)
-;; (xungrab-pointer)
-;; (grab-main-keys))
-;; (adapt-window-to-group (current-window) (current-group))
-;; (focus-window (current-window))
-;; (show-all-group (current-workspace))
-;; (wait-no-key-or-button-press))))
-
-
-
-;;;;; Alternative - Second mode with big screen border
-;;(let ((border-size 5)
-;; (border-color "Green"))
-;; (defun second-key-mode ()
-;; "Switch to editing mode"
-;; (let* ((windows (list (create-window :parent *root* :x 0 :y 0
-;; :width (screen-width *screen*) :height border-size
-;; :background (get-color border-color)
-;; :colormap (screen-default-colormap *screen*))
-;; (create-window :parent *root* :x 0 :y (- (screen-height *screen*) border-size)
-;; :width (screen-width *screen*) :height border-size
-;; :background (get-color border-color)
-;; :colormap (screen-default-colormap *screen*))
-;; (create-window :parent *root* :x 0 :y border-size
-;; :width border-size :height (- (screen-height *screen*) (* border-size 2))
-;; :background (get-color border-color)
-;; :colormap (screen-default-colormap *screen*))
-;; (create-window :parent *root* :x (- (screen-width *screen*) border-size)
-;; :y border-size
-;; :width border-size :height (- (screen-height *screen*) (* border-size 2))
-;; :background (get-color border-color)
-;; :colormap (screen-default-colormap *screen*)))))
-;; (labels ((draw-second-mode-window ()
-;; (dolist (win windows)
-;; (raise-window win)))
-;; (handle-key-press (&rest event-slots &key root code state &allow-other-keys)
-;; (declare (ignore event-slots root))
-;; (funcall-key-from-code *second-keys* code state))
-;; (handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (focus-group-under-mouse root-x root-y))
-;; (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
-;; (:motion-notify () t))
-;; (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)))
-;; (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (funcall-button-from-code *mouse-action* code state root-x root-y #'first))
-;; (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (funcall-button-from-code *mouse-action* code state root-x root-y #'third))
-;; (handle-event (&rest event-slots &key display event-key &allow-other-keys)
-;; (declare (ignore display))
-;; (handler-case
-;; (case event-key
-;; (:key-press (apply #'handle-key-press event-slots))
-;; (:enter-notify (apply #'handle-enter-notify event-slots))
-;; (:motion-notify (apply #'handle-motion-notify event-slots))
-;; (:button-press (apply #'handle-button-press event-slots))
-;; (:button-release (apply #'handle-button-release event-slots))
-;; (:configure-request (apply #'handle-configure-request event-slots))
-;; (:map-request (apply #'handle-map-request event-slots))
-;; (:unmap-notify (apply #'handle-unmap-notify event-slots))
-;; (:destroy-notify (apply #'handle-destroy-notify event-slots))
-;; (:mapping-notify nil)
-;; (:property-notify nil)
-;; (:create-notify nil))
-;; ((or drawable-error window-error) (c)
[26 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/01/03 20:31:24 1.10
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/24 20:53:37 1.11
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Wed Jan 2 23:45:31 2008
+;;; #Date#: Fri Feb 22 22:44:09 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -28,429 +28,549 @@
(in-package :clfswm)
-;;;,-----
-;;;| Various definitions
-;;;`-----
-(defun stop-all-pending-actions ()
- "Stop all pending actions (actions like open in new workspace/group)"
- (setf *open-next-window-in-new-workspace* nil
- *open-next-window-in-new-group* nil
- *arrow-action* nil
- *pager-arrow-action* nil))
-
-(defun rotate-window-up ()
- "Rotate up windows in the current group"
- (setf (group-window-list (current-group))
- (rotate-list (group-window-list (current-group))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun rotate-window-down ()
- "Rotate down windows in the current group"
- (setf (group-window-list (current-group))
- (anti-rotate-list (group-window-list (current-group))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-
-(defun maximize-group (group)
- "Maximize the group"
- (when group
- (unless (group-fullscreenp group)
- (setf (group-fullscreenp group) t)))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun minimize-group (group)
- "Minimize the group"
- (when group
- (when (group-fullscreenp group)
- (setf (group-fullscreenp group) nil)))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun toggle-maximize-group (group)
- "Maximize/minimize a group"
- (if (group-fullscreenp group)
- (minimize-group group)
- (maximize-group group)))
-
-
-(defun toggle-maximize-current-group ()
- "Maximize/minimize the current group"
- (toggle-maximize-group (current-group)))
-
-
-(defun banish-pointer ()
- "Move the pointer to the lower right corner of the screen and redraw all groups"
- (warp-pointer *root*
- (1- (screen-width *screen*))
- (1- (screen-height *screen*)))
- (show-all-group (current-workspace)))
-
-
-(defun renumber-workspaces ()
- "Reset workspaces numbers (1 for current workspace, 2 for the second...) "
- (hide-all-windows-in-workspace (current-workspace))
- (setf *current-workspace-number* 0)
- (loop for workspace in *workspace-list* do
- (setf (workspace-number workspace) (incf *current-workspace-number*)))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-(defun sort-workspaces ()
- "Sort workspaces by numbers"
- (hide-all-windows-in-workspace (current-workspace))
- (setf *workspace-list* (sort *workspace-list*
- #'(lambda (x y)
- (< (workspace-number x) (workspace-number y)))))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-
-
-(defun circulate-group-up ()
- "Circulate up in group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (setf (workspace-group-list (current-workspace))
- (rotate-list (workspace-group-list (current-workspace))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-
-(defun circulate-group-up-move-window ()
- "Circulate up in group moving the current window in the next group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (let ((window (current-window)))
- (remove-window-in-group window (current-group))
- (focus-window (current-window))
- (setf (workspace-group-list (current-workspace))
- (rotate-list (workspace-group-list (current-workspace))))
- (add-window-in-group window (current-group)))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun circulate-group-up-copy-window ()
- "Circulate up in group copying the current window in the next group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (let ((window (current-window)))
- (setf (workspace-group-list (current-workspace))
- (rotate-list (workspace-group-list (current-workspace))))
- (unless (window-already-in-workspace window (current-workspace))
- (add-window-in-group window (current-group))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-
-
-(defun circulate-group-down ()
- "Circulate down in group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (setf (workspace-group-list (current-workspace))
- (anti-rotate-list (workspace-group-list (current-workspace))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun circulate-group-down-move-window ()
- "Circulate down in group moving the current window in the next group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (let ((window (current-window)))
- (remove-window-in-group window (current-group))
- (focus-window (current-window))
- (setf (workspace-group-list (current-workspace))
- (anti-rotate-list (workspace-group-list (current-workspace))))
- (add-window-in-group window (current-group)))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun circulate-group-down-copy-window ()
- "Circulate down in group copying the current window in the next group"
- (banish-pointer)
- (minimize-group (current-group))
- (no-focus)
- (let ((window (current-window)))
- (setf (workspace-group-list (current-workspace))
- (anti-rotate-list (workspace-group-list (current-workspace))))
- (unless (window-already-in-workspace window (current-workspace))
- (add-window-in-group window (current-group))))
- (adapt-window-to-group (current-window) (current-group))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
+(defun add-default-group ()
+ "Add a default group"
+ (when (group-p *current-child*)
+ (push (create-group) (group-child *current-child*))
+ (show-all-childs)))
+
+(defun add-placed-group ()
+ "Add a placed group"
+ (when (group-p *current-child*)
+ (let ((name (query-string "Group name"))
+ (x (/ (query-number "Group x in percent (%)") 100))
+ (y (/ (query-number "Group y in percent (%)") 100))
+ (w (/ (query-number "Group width in percent (%)") 100))
+ (h (/ (query-number "Group height in percent (%)") 100)))
+ (push (create-group :name name :x x :y y :w w :h h)
+ (group-child *current-child*)))
+ (show-all-childs)))
-
-(defun circulate-workspace-by-number (number)
- "Focus a workspace given its number"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (dotimes (i (length *workspace-list*))
- (when (= (workspace-number (current-workspace)) number)
- (return))
- (setf *workspace-list* (rotate-list *workspace-list*)))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-(defun circulate-workspace-up ()
- "Circulate up in workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (setf *workspace-list* (rotate-list *workspace-list*))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun circulate-workspace-up-move-group ()
- "Circulate up in workspace moving current group in the next workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (let ((group (current-group)))
- (remove-group-in-workspace group (current-workspace))
- (setf *workspace-list* (rotate-list *workspace-list*))
- (add-group-in-workspace (copy-group group) (current-workspace)))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun circulate-workspace-up-copy-group ()
- "Circulate up in workspace copying current group in the next workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (let ((group (current-group)))
- (setf *workspace-list* (rotate-list *workspace-list*))
- (unless (group-windows-already-in-workspace group (current-workspace))
- (add-group-in-workspace (copy-group group) (current-workspace))))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-
-(defun circulate-workspace-down ()
- "Circulate down in workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (setf *workspace-list* (anti-rotate-list *workspace-list*))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun circulate-workspace-down-move-group ()
- "Circulate down in workspace moving current group in the next workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (let ((group (current-group)))
- (remove-group-in-workspace group (current-workspace))
- (setf *workspace-list* (anti-rotate-list *workspace-list*))
- (add-group-in-workspace (copy-group group) (current-workspace)))
- (show-all-windows-in-workspace (current-workspace)))
-
-(defun circulate-workspace-down-copy-group ()
- "Circulate down in workspace copying current group in the next workspace"
- (no-focus)
- (hide-all-windows-in-workspace (current-workspace))
- (let ((group (current-group)))
- (setf *workspace-list* (anti-rotate-list *workspace-list*))
- (unless (group-windows-already-in-workspace group (current-workspace))
- (add-group-in-workspace (copy-group group) (current-workspace))))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-
-(defun delete-current-window ()
- "Delete the current window in all groups and workspaces"
- (let ((window (current-window)))
- (when window
- (no-focus)
- (remove-window-in-all-workspace window)
+(defun delete-focus-window ()
+ "Delete the focus window in all groups and workspaces"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (remove-child-in-all-groups window)
(send-client-message window :WM_PROTOCOLS
- (intern-atom *display* "WM_DELETE_WINDOW"))))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-
-(defun destroy-current-window ()
- "Destroy the current window in all groups and workspaces"
- (let ((window (current-window)))
- (when window
- (no-focus)
- (remove-window-in-all-workspace window)
- (kill-client *display* (window-id window))))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun remove-current-window ()
- "Remove the current window in the current group"
- (let ((window (current-window)))
- (when window
- (no-focus)
- (hide-window window)
- (remove-window-in-group (current-window) (current-group))))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun remove-current-group ()
- "Remove the current group in the current workspace"
- (minimize-group (current-group))
- (let ((group (current-group)))
- (when group
- (no-focus)
- (dolist (window (group-window-list group))
- (when window
- (hide-window window)))
- (remove-group-in-workspace group (current-workspace))))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-(defun remove-current-workspace ()
- "Remove the current workspace"
- (let ((workspace (current-workspace)))
- (when workspace
- (hide-all-windows-in-workspace workspace)
- (remove-workspace workspace)
- (show-all-windows-in-workspace (current-workspace)))))
-
-
-(defun unhide-all-windows-in-current-group ()
- "Unhide all hidden windows into the current group"
- (let ((all-windows (get-all-windows))
- (hidden-windows (remove-if-not #'window-hidden-p
- (copy-list (query-tree *root*))))
- (current-group (current-group)))
- (dolist (window (set-difference hidden-windows all-windows))
+ (xlib:intern-atom *display* "WM_DELETE_WINDOW"))
+ (show-all-childs))))
+
+(defun destroy-focus-window ()
+ "Destroy the focus window in all groups and workspaces"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (remove-child-in-all-groups window)
+ (xlib:kill-client *display* (xlib:window-id window))
+ (show-all-childs))))
+
+(defun remove-focus-window ()
+ "Remove the focus window in the current group"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (setf *current-child* *current-root*)
+ (hide-child window)
+ (remove-child-in-group window (find-father-group window))
+ (show-all-childs))))
+
+
+(defun unhide-all-windows-in-current-child ()
+ "Unhide all hidden windows into the current child"
+ (with-xlib-protect
+ (dolist (window (get-hidden-windows))
(unhide-window window)
(process-new-window window)
- (map-window window)
- (adapt-window-to-group window current-group)))
- (focus-window (current-window))
- (show-all-group (current-workspace)))
-
-
-
-
-(defun create-new-default-group ()
- "Create a new default group"
- (minimize-group (current-group))
- (add-group-in-workspace (copy-group *default-group*)
- (current-workspace))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-(defun create-new-default-workspace ()
- "Create a new default workspace"
- (hide-all-windows-in-workspace (current-workspace))
- (add-workspace (create-default-workspace))
- (show-all-windows-in-workspace (current-workspace)))
-
-
-
-
-;;;,-----
-;;;| Group moving
-;;;`-----
-(defun move-group (group dx dy)
- "Move group"
- (setf (group-x group) (+ (group-x group) dx)
- (group-y group) (+ (group-y group) dy))
- (dolist (window (group-window-list group))
- (adapt-window-to-group window group))
- (show-all-group (current-workspace)))
-
[727 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm.asd 2008/01/03 20:31:24 1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm.asd 2008/02/24 20:53:37 1.7
@@ -2,7 +2,7 @@
;;;; Author: Philippe Brochard <hocwp at free.fr>
;;;; ASDF System Definition
;;;
-;;; #date#: Wed Jan 2 23:30:31 2008
+;;; #date#: Fri Feb 22 21:39:37 2008
(in-package #:asdf)
@@ -13,43 +13,36 @@
:licence "GNU Public License (GPL)"
:components ((:file "tools")
(:file "my-html"
- :depends-on ("tools"))
+ :depends-on ("tools"))
(:file "package"
- :depends-on ("my-html" "tools"))
+ :depends-on ("my-html" "tools"))
(:file "config"
- :depends-on ("package"))
+ :depends-on ("package"))
(:file "keysyms"
- :depends-on ("package"))
+ :depends-on ("package"))
(:file "xlib-util"
- :depends-on ("package" "keysyms" "config"))
+ :depends-on ("package" "keysyms" "config"))
(:file "netwm-util"
- :depends-on ("package" "xlib-util"))
+ :depends-on ("package" "xlib-util"))
(:file "clfswm-keys"
- :depends-on ("package" "config" "xlib-util" "keysyms"))
+ :depends-on ("package" "config" "xlib-util" "keysyms"))
(:file "clfswm-internal"
- :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
- (:file "clfswm-second-mode"
- :depends-on ("package" "clfswm-internal"))
+ :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
(:file "clfswm"
- :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
- "clfswm-internal" "clfswm-second-mode" "tools"))
- (:file "clfswm-util"
- :depends-on ("clfswm" "keysyms"))
- (:file "clfswm-pack"
- :depends-on ("clfswm" "clfswm-util"))
- (:file "clfswm-pager"
- :depends-on ("clfswm" "clfswm-util" "clfswm-pack"))
+ :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
+ "clfswm-internal" "tools"))
+ (:file "clfswm-second-mode"
+ :depends-on ("package" "clfswm-internal"))
(:file "clfswm-info"
- :depends-on ("clfswm" "clfswm-pager"))
+ :depends-on ("package" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+ (:file "clfswm-util"
+ :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode"))
+ (:file "clfswm-layout"
+ :depends-on ("package" "clfswm-util" "clfswm-info"))
(:file "bindings"
- :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
+ :depends-on ("clfswm" "clfswm-internal"))
(:file "bindings-second-mode"
- :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
- (:file "bindings-pager"
- :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-pager"
- "clfswm-info" "bindings"))))
-
-
+ :depends-on ("clfswm" "clfswm-util"))))
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/01/05 14:25:29 1.12
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/24 20:53:37 1.13
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Jan 5 15:16:21 2008
+;;; #Date#: Sun Feb 24 21:36:00 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -38,46 +38,6 @@
-;;(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
-;; x y width height border-width value-mask &allow-other-keys)
-;; (declare (ignore event-slots))
-;; (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))))
-;; (handler-case
-;; (progn
-;; (with-state (window)
-;; (when (has-x value-mask)
-;; (setf (drawable-x window) x))
-;; (when (has-y value-mask)
-;; (setf (drawable-y window) y))
-;; (when (has-h value-mask)
-;; (setf (drawable-height window) height))
-;; (when (has-w value-mask)
-;; (setf (drawable-width window) width))
-;; (when (has-bw value-mask)
-;; (setf (drawable-border-width window) border-width)))
-;; ;; The ICCCM says with have to send a fake configure-notify if
-;; ;; the window is moved but not resized.
-;; (when (member window (group-window-list (current-group)))
-;; (unless (or (logbitp 2 value-mask) (logbitp 3 value-mask))
-;; (send-configuration-notify window))
-;; (adapt-window-to-group window (current-group))
-;; (when (has-stackmode value-mask)
-;; (case stack-mode
-;; (:above (raise-window window))))))
-;; ((or match-error window-error drawable-error) (c)
-;; (declare (ignore c))))))
-;; ;;(dbg "Configure Error" c)))))
-;;
-;;
-;;
-;;(defun handle-configure-notify (&rest event-slots)
-;; (declare (ignore event-slots))
-;; (adapt-all-window-in-workspace (current-workspace)))
(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
x y width height border-width value-mask &allow-other-keys)
@@ -87,29 +47,26 @@
(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)))
+ (has-stackmode (mask) (= 64 (logand mask 64)))
(adjust-from-request ()
- (when (has-x value-mask) (setf (drawable-x window) x))
- (when (has-y value-mask) (setf (drawable-y window) y))
- (when (has-h value-mask) (setf (drawable-height window) height))
- (when (has-w value-mask) (setf (drawable-width window) width))))
- (handler-case
- (progn
- (with-state (window)
- (when (has-bw value-mask)
- (setf (drawable-border-width window) border-width))
- (if (window-already-in-workspace window (current-workspace))
- (case (window-type window)
- (:normal (adapt-window-to-group window (find-window-group window (current-workspace)))
- (send-configuration-notify window))
- (t (adjust-from-request)))
- (adjust-from-request))
- (when (has-stackmode value-mask)
- (case stack-mode
- (:above (raise-window window))))))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Configure Error" c)))))
+ (when (has-x value-mask) (setf (xlib:drawable-x window) x))
+ (when (has-y value-mask) (setf (xlib:drawable-y window) y))
+ (when (has-h value-mask) (setf (xlib:drawable-height window) height))
+ (when (has-w value-mask) (setf (xlib:drawable-width window) width))))
+ (with-xlib-protect
+ (xlib:with-state (window)
+ (when (has-bw value-mask)
+ (setf (xlib:drawable-border-width window) border-width))
+ (if (find-child window *current-root*)
+ (case (window-type window)
+ (:normal (adapt-child-to-father window (find-father-group window *current-root*))
+ (send-configuration-notify window))
+ (t (adjust-from-request)))
+ (adjust-from-request))
+ (when (has-stackmode value-mask)
+ (case stack-mode
+ (:above (raise-window window))))))))
+
@@ -124,41 +81,39 @@
(unless send-event-p
(unhide-window window)
(process-new-window window)
- (map-window window)
+ (xlib:map-window window)
(focus-window window)
- (show-all-group (current-workspace))))
+ (show-all-childs)))
(defun handle-unmap-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
(declare (ignore event-slots))
(unless (and (not send-event-p)
- (not (window-equal window event-window)))
- (let ((found-p (find window (get-all-windows) :test 'window-equal)))
- (remove-window-in-all-workspace window)
- (when found-p
- (show-all-windows-in-workspace (current-workspace))))))
-
+ (not (xlib:window-equal window event-window)))
+ (when (find-child window *root-group*)
+ (remove-child-in-all-groups window)
+ (show-all-childs))))
(defun handle-destroy-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
(declare (ignore event-slots))
(unless (or send-event-p
- (window-equal event-window window))
- (let ((found-p (find window (get-all-windows) :test 'window-equal)))
- (remove-window-in-all-workspace window)
- (when found-p
- (show-all-windows-in-workspace (current-workspace))))))
+ (xlib:window-equal window event-window))
+ (when (find-child window *root-group*)
+ (remove-child-in-all-groups window)
+ (show-all-childs))))
(defun handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots))
- (unless (group-fullscreenp (current-group))
- (focus-group-under-mouse root-x root-y)))
+ (declare (ignore event-slots root-x root-y)))
+
-(defun handle-exposure (&rest event-slots)
+
+(defun handle-exposure (&rest event-slots &key window &allow-other-keys)
(declare (ignore event-slots))
- (show-all-group (current-workspace) *root* *root-gc* nil))
+ (awhen (find-group-window window *current-root*)
+ (display-group-info it)))
(defun handle-create-notify (&rest event-slots)
@@ -166,17 +121,43 @@
+;; PHIL: TODO: focus-policy par group
+;; :click, :sloppy, :nofocus
+(defun handle-click-to-focus (window)
+ (let ((to-replay t)
+ (child window)
+ (father (find-father-group window *current-root*)))
+ (unless father
+ (setf child (find-group-window window *current-root*)
+ father (find-father-group child *current-root*)))
+ (when (and child father (focus-all-child child father))
+ (show-all-childs)
+ (setf to-replay nil))
+ (if to-replay (replay-button-event) (stop-button-event))))
+
+
+(defun handle-button-press (&rest event-slots &key code state window &allow-other-keys)
+ (declare (ignore event-slots))
+ (if (and (= code 1) (= state 0))
+ (handle-click-to-focus window)
+ (replay-button-event)))
+
+
+
+
+
+
;;; CONFIG: Main mode hooks
(setf *key-press-hook* #'handle-key-press
*configure-request-hook* #'handle-configure-request
*configure-notify-hook* #'handle-configure-notify
- *destroy-notify-hook* #'handle-destroy-notify
+ *destroy-notify-hook* 'handle-destroy-notify
*enter-notify-hook* #'handle-enter-notify
- *exposure-hook* #'handle-exposure
+ *exposure-hook* 'handle-exposure
*map-request-hook* #'handle-map-request
- *unmap-notify-hook* #'handle-unmap-notify
- *create-notify-hook* #'handle-create-notify)
-
+ *unmap-notify-hook* 'handle-unmap-notify
+ *create-notify-hook* #'handle-create-notify
+ *button-press-hook* 'handle-button-press)
@@ -184,117 +165,103 @@
(defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
;;(dbg event-key)
- (handler-case
- (case event-key
- (:button-press (call-hook *button-press-hook* event-slots))
- (:key-press (call-hook *key-press-hook* event-slots))
- (:configure-request (call-hook *configure-request-hook* event-slots))
- (:configure-notify (call-hook *configure-notify-hook* event-slots))
- (:map-request (call-hook *map-request-hook* event-slots))
- (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
- (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
- (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
- (:property-notify (call-hook *property-notify-hook* event-slots))
- (:create-notify (call-hook *create-notify-hook* event-slots))
- (:enter-notify (call-hook *enter-notify-hook* event-slots))
- (:exposure (call-hook *exposure-hook* event-slots)))
- ((or drawable-error window-error) (c)
- (declare (ignore c))))
- ;;(dbg "Ignore handle event" c event-slots)))
+ (with-xlib-protect
+ (case event-key
+ (:button-press (call-hook *button-press-hook* event-slots))
+ (:motion-notify (call-hook *button-motion-notify-hook* event-slots))
+ (:key-press (call-hook *key-press-hook* event-slots))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots))
+ (:enter-notify (call-hook *enter-notify-hook* event-slots))
+ (:exposure (call-hook *exposure-hook* event-slots))))
t)
(defun main-loop ()
(loop
- (handler-case
- (progn
- (display-finish-output *display*)
- (process-event *display* :handler #'handle-event))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Main loop finish" c)))))
-
-
-(defun process-existing-windows (screen)
- "Windows present when clfswm starts up must be absorbed by clfswm."
- (let ((children (query-tree (screen-root screen)))
- (id-list nil))
- (dolist (win children)
- (let ((map-state (window-map-state win))
- (wm-state (window-state win)))
- (unless (or (eql (window-override-redirect win) :on)
- (eql win *no-focus-window*))
- (when (or (eql map-state :viewable)
- (eql wm-state +iconic-state+))
- (format t "Processing ~S ~S~%" (wm-name win) win)
- (unhide-window win)
- (process-new-window win)
- (map-window win)
- (push (window-id win) id-list)))))
- (netwm-set-client-list id-list)))
-
-
-
-
+ (with-xlib-protect
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-event))))
+;;(dbg "Main loop finish" c)))))
-
-(defun parse-display-string (display)
- "Parse an X11 DISPLAY string and return the host and display from it."
- (let* ((colon (position #\: display))
- (host (subseq display 0 colon))
- (rest (subseq display (1+ colon)))
- (dot (position #\. rest))
- (num (parse-integer (subseq rest 0 dot))))
- (values host num)))
-
+(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)
+ (getenv "DISPLAY") display-str)))
-(defun init-display (display-str protocol)
- (multiple-value-bind (host display-num) (parse-display-string display-str)
- (setf *display* (open-display host :display display-num :protocol protocol)
- *screen* (first (display-roots *display*))
- *root* (screen-root *screen*)
- *no-focus-window* (create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
- *root-gc* (create-gcontext :drawable *root*
- :foreground (get-color *color-unselected*)
- :background (get-color "Black")
- :line-style :solid)))
+(defun init-display ()
+ (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)
+ *root-gc* (xlib:create-gcontext :drawable *root*
+ :foreground (get-color *color-unselected*)
+ :background (get-color "Black")
+ :line-style :solid)
+ *default-font* (xlib:open-font *display* *default-font-string*))
(xgrab-init-pointer)
(xgrab-init-keyboard)
- (map-window *no-focus-window*)
- (setf *workspace-list* nil
- *current-workspace-number* 0
- *open-next-window-in-new-workspace* nil
- *open-next-window-in-new-group* nil
- *arrow-action* nil
- *pager-arrow-action* nil)
- (destructuring-bind (x y width height) *fullscreen*
- (setf *default-group* (make-group :x x :y y :width width :height height :fullscreenp nil)))
- (add-workspace (make-workspace :number (incf *current-workspace-number*)
- :group-list (list (copy-group *default-group*))))
- (setf (group-fullscreenp (current-group)) t)
+ ;;(xgrab-pointer *root* 66 67 '(:enter-window :button-press :button-release) t) ;; PHIL
+ ;;(grab-pointer *root* '(:button-press :button-release)
+ ;; :owner-p t :sync-keyboard-p nil :sync-pointer-p nil)
+ ;;(grab-button *root* 1 nil ;;'(:button-press :button-release)
+ ;; :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil)
+ ;;(xlib:grab-pointer *root* nil :owner-p nil)
+ (xlib:map-window *no-focus-window*)
(dbg *display*)
- (setf (getenv "DISPLAY") display-str)
- (setf (window-event-mask *root*)
- '(:substructure-redirect
- :substructure-notify
- :property-change
- :exposure))
+ (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
+ :substructure-notify
+ :property-change
+ :exposure
+ :button-press))
+ ;;(intern-atoms *display*)
(netwm-set-properties)
- (display-force-output *display*)
+ (xlib:display-force-output *display*)
+ (setf *child-selection* nil
+ *current-group-number* -1)
+ (setf *root-group* (create-group :name "Root" :layout #'tile-space-layout)
+ *current-root* *root-group*
+ *current-child* *current-root*)
+ (call-hook *init-hook*)
+;; (add-group (create-group :name "Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-group*)
+;; (add-group (create-group :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-group*)
+;; (add-group (create-group :x 0 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.4 :y 0 :w 0.2 :h 0.3) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-group*)
+;; (add-group (create-group :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (group-child *root-group*)))
+;; (add-group (create-group :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (group-child (first (group-child *root-group*)))))
+;; (setf *current-child* (first (group-child *current-root*)))
+;; (setf (group-layout *current-child*) #'tile-layout)
(process-existing-windows *screen*)
- (focus-window (current-window))
- (show-all-group (current-workspace))
+ (show-all-childs)
(grab-main-keys)
- (display-finish-output *display*))
+ (xlib:display-finish-output *display*))
+
+
+
+(defun xdg-config-home ()
+ (pathname-directory (concatenate 'string (or (getenv "XDG_CONFIG_HOME")
+ (getenv "HOME"))
+ "/")))
(defun read-conf-file ()
(let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))
[51 lines skipped]
--- /project/clfswm/cvsroot/clfswm/config.lisp 2008/01/03 20:31:24 1.7
+++ /project/clfswm/cvsroot/clfswm/config.lisp 2008/02/24 20:53:37 1.8
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Wed Jan 2 23:40:41 2008
+;;; #Date#: Fri Feb 22 15:14:03 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Configuration file
@@ -41,16 +41,21 @@
;;; CONFIG - Screen size
-;;(defparameter *fullscreen* '(0 0 1024 600))
-(defparameter *fullscreen* '(0 0 1024 768))
-;;(defparameter *fullscreen* '(0 0 1280 960))
-;;(defparameter *fullscreen* '(100 0 1180 960)) ;; Example with a space on left.
-;;(defparameter *fullscreen* '(0 0 800 600))
+(defun get-fullscreen-size ()
+ "Return the size of root child - you can tweak this to what you want"
+ (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
+;; (values -1 -1 1024 768))
+;; (values 100 100 800 600))
+
+
+
+
;;; CONFIG: Main mode colors
(defparameter *color-selected* "Red")
-(defparameter *color-unselected* "Yellow")
+(defparameter *color-unselected* "Blue")
+(defparameter *color-maybe-selected* "Yellow")
;;; CONFIG: Second mode colors and fonts
(defparameter *sm-border-color* "Green")
@@ -89,7 +94,7 @@
;;; CONFIG - Identify key colors
-(defparameter *identify-font-string* "9x15bold")
+(defparameter *identify-font-string* "9x15")
(defparameter *identify-background* "black")
(defparameter *identify-foreground* "green")
(defparameter *identify-border* "red")
@@ -107,7 +112,7 @@
(defparameter *info-foreground* "green")
(defparameter *info-border* "red")
(defparameter *info-line-cursor* "white")
-(defparameter *info-font-string* "9x15bold")
+(defparameter *info-font-string* "9x15")
--- /project/clfswm/cvsroot/clfswm/keysyms.lisp 2007/05/15 19:49:51 1.1
+++ /project/clfswm/cvsroot/clfswm/keysyms.lisp 2008/02/24 20:53:37 1.2
@@ -49,8 +49,8 @@
(declare (ignore present-p))
value))
-(cl-define-keysym #xffffff "VoidSymbol") ;Void symbol
-(cl-define-keysym #xff08 "BackSpace") ;Back space, back char
+(cl-define-keysym #xffffff "VoidSymbol") ;Void symbol
+(cl-define-keysym #xff08 "BackSpace") ;Back space, back char
(cl-define-keysym #xff09 "Tab")
(cl-define-keysym #xff0a "Linefeed") ;Linefeed, LF
(cl-define-keysym #xff0b "Clear")
@@ -59,60 +59,60 @@
(cl-define-keysym #xff14 "Scroll_Lock")
(cl-define-keysym #xff15 "Sys_Req")
(cl-define-keysym #xff1b "Escape")
-(cl-define-keysym #xffff "Delete") ;Delete, rubout
+(cl-define-keysym #xffff "Delete") ;Delete, rubout
(cl-define-keysym #xff20 "Multi_key") ;Multi-key character compose
(cl-define-keysym #xff37 "Codeinput")
(cl-define-keysym #xff3c "SingleCandidate")
(cl-define-keysym #xff3d "MultipleCandidate")
(cl-define-keysym #xff3e "PreviousCandidate")
-(cl-define-keysym #xff21 "Kanji") ;Kanji, Kanji convert
+(cl-define-keysym #xff21 "Kanji") ;Kanji, Kanji convert
(cl-define-keysym #xff22 "Muhenkan") ;Cancel Conversion
(cl-define-keysym #xff23 "Henkan_Mode") ;Start/Stop Conversion
-(cl-define-keysym #xff23 "Henkan") ;Alias for Henkan_Mode
-(cl-define-keysym #xff24 "Romaji") ;to Romaji
+(cl-define-keysym #xff23 "Henkan") ;Alias for Henkan_Mode
+(cl-define-keysym #xff24 "Romaji") ;to Romaji
(cl-define-keysym #xff25 "Hiragana") ;to Hiragana
(cl-define-keysym #xff26 "Katakana") ;to Katakana
(cl-define-keysym #xff27 "Hiragana_Katakana") ;Hiragana/Katakana toggle
-(cl-define-keysym #xff28 "Zenkaku") ;to Zenkaku
-(cl-define-keysym #xff29 "Hankaku") ;to Hankaku
+(cl-define-keysym #xff28 "Zenkaku") ;to Zenkaku
+(cl-define-keysym #xff29 "Hankaku") ;to Hankaku
(cl-define-keysym #xff2a "Zenkaku_Hankaku") ;Zenkaku/Hankaku toggle
-(cl-define-keysym #xff2b "Touroku") ;Add to Dictionary
-(cl-define-keysym #xff2c "Massyo") ;Delete from Dictionary
-(cl-define-keysym #xff2d "Kana_Lock") ;Kana Lock
-(cl-define-keysym #xff2e "Kana_Shift") ;Kana Shift
-(cl-define-keysym #xff2f "Eisu_Shift") ;Alphanumeric Shift
-(cl-define-keysym #xff30 "Eisu_toggle") ;Alphanumeric toggle
-(cl-define-keysym #xff37 "Kanji_Bangou") ;Codeinput
+(cl-define-keysym #xff2b "Touroku") ;Add to Dictionary
+(cl-define-keysym #xff2c "Massyo") ;Delete from Dictionary
+(cl-define-keysym #xff2d "Kana_Lock") ;Kana Lock
+(cl-define-keysym #xff2e "Kana_Shift") ;Kana Shift
+(cl-define-keysym #xff2f "Eisu_Shift") ;Alphanumeric Shift
+(cl-define-keysym #xff30 "Eisu_toggle") ;Alphanumeric toggle
+(cl-define-keysym #xff37 "Kanji_Bangou") ;Codeinput
(cl-define-keysym #xff3d "Zen_Koho") ;Multiple/All Candidate(s)
(cl-define-keysym #xff3e "Mae_Koho") ;Previous Candidate
(cl-define-keysym #xff50 "Home")
-(cl-define-keysym #xff51 "Left") ;Move left, left arrow
+(cl-define-keysym #xff51 "Left") ;Move left, left arrow
(cl-define-keysym #xff52 "Up") ;Move up, up arrow
-(cl-define-keysym #xff53 "Right") ;Move right, right arrow
-(cl-define-keysym #xff54 "Down") ;Move down, down arrow
-(cl-define-keysym #xff55 "Prior") ;Prior, previous
+(cl-define-keysym #xff53 "Right") ;Move right, right arrow
+(cl-define-keysym #xff54 "Down") ;Move down, down arrow
+(cl-define-keysym #xff55 "Prior") ;Prior, previous
(cl-define-keysym #xff55 "Page_Up")
-(cl-define-keysym #xff56 "Next") ;Next
+(cl-define-keysym #xff56 "Next") ;Next
(cl-define-keysym #xff56 "Page_Down")
-(cl-define-keysym #xff57 "End") ;EOL
+(cl-define-keysym #xff57 "End") ;EOL
(cl-define-keysym #xff58 "Begin") ;BOL
(cl-define-keysym #xff60 "Select") ;Select, mark
(cl-define-keysym #xff61 "Print")
-(cl-define-keysym #xff62 "Execute") ;Execute, run, do
+(cl-define-keysym #xff62 "Execute") ;Execute, run, do
(cl-define-keysym #xff63 "Insert") ;Insert, insert here
(cl-define-keysym #xff65 "Undo")
-(cl-define-keysym #xff66 "Redo") ;Redo, again
+(cl-define-keysym #xff66 "Redo") ;Redo, again
(cl-define-keysym #xff67 "Menu")
(cl-define-keysym #xff68 "Find") ;Find, search
-(cl-define-keysym #xff69 "Cancel") ;Cancel, stop, abort, exit
-(cl-define-keysym #xff6a "Help") ;Help
+(cl-define-keysym #xff69 "Cancel") ;Cancel, stop, abort, exit
+(cl-define-keysym #xff6a "Help") ;Help
(cl-define-keysym #xff6b "Break")
-(cl-define-keysym #xff7e "Mode_switch") ;Character set switch
-(cl-define-keysym #xff7e "script_switch") ;Alias for mode_switch
+(cl-define-keysym #xff7e "Mode_switch") ;Character set switch
+(cl-define-keysym #xff7e "script_switch") ;Alias for mode_switch
(cl-define-keysym #xff7f "Num_Lock")
(cl-define-keysym #xff80 "KP_Space") ;Space
(cl-define-keysym #xff89 "KP_Tab")
-(cl-define-keysym #xff8d "KP_Enter") ;Enter
+(cl-define-keysym #xff8d "KP_Enter") ;Enter
(cl-define-keysym #xff91 "KP_F1") ;PF1, KP_A, ...
(cl-define-keysym #xff92 "KP_F2")
(cl-define-keysym #xff93 "KP_F3")
@@ -133,7 +133,7 @@
(cl-define-keysym #xffbd "KP_Equal") ;Equals
(cl-define-keysym #xffaa "KP_Multiply")
(cl-define-keysym #xffab "KP_Add")
-(cl-define-keysym #xffac "KP_Separator") ;Separator, often comma
+(cl-define-keysym #xffac "KP_Separator") ;Separator, often comma
(cl-define-keysym #xffad "KP_Subtract")
(cl-define-keysym #xffae "KP_Decimal")
(cl-define-keysym #xffaf "KP_Divide")
@@ -213,10 +213,10 @@
(cl-define-keysym #xffe4 "Control_R") ;Right control
(cl-define-keysym #xffe5 "Caps_Lock") ;Caps lock
(cl-define-keysym #xffe6 "Shift_Lock") ;Shift lock
-(cl-define-keysym #xffe7 "Meta_L") ;Left meta
-(cl-define-keysym #xffe8 "Meta_R") ;Right meta
-(cl-define-keysym #xffe9 "Alt_L") ;Left alt
-(cl-define-keysym #xffea "Alt_R") ;Right alt
+(cl-define-keysym #xffe7 "Meta_L") ;Left meta
+(cl-define-keysym #xffe8 "Meta_R") ;Right meta
+(cl-define-keysym #xffe9 "Alt_L") ;Left alt
+(cl-define-keysym #xffea "Alt_R") ;Right alt
(cl-define-keysym #xffeb "Super_L") ;Left super
(cl-define-keysym #xffec "Super_R") ;Right super
(cl-define-keysym #xffed "Hyper_L") ;Left hyper
@@ -354,10 +354,10 @@
(cl-define-keysym #xfd1d "3270_PrintScreen")
(cl-define-keysym #xfd1e "3270_Enter")
(cl-define-keysym #x0020 "space") ;U+0020 SPACE
-(cl-define-keysym #x0021 "exclam") ;U+0021 EXCLAMATION MARK
+(cl-define-keysym #x0021 "exclam") ;U+0021 EXCLAMATION MARK
(cl-define-keysym #x0022 "quotedbl") ;U+0022 QUOTATION MARK
(cl-define-keysym #x0023 "numbersign") ;U+0023 NUMBER SIGN
-(cl-define-keysym #x0024 "dollar") ;U+0024 DOLLAR SIGN
+(cl-define-keysym #x0024 "dollar") ;U+0024 DOLLAR SIGN
(cl-define-keysym #x0025 "percent") ;U+0025 PERCENT SIGN
(cl-define-keysym #x0026 "ampersand") ;U+0026 AMPERSAND
(cl-define-keysym #x0027 "apostrophe") ;U+0027 APOSTROPHE
@@ -365,11 +365,11 @@
(cl-define-keysym #x0028 "parenleft") ;U+0028 LEFT PARENTHESIS
(cl-define-keysym #x0029 "parenright") ;U+0029 RIGHT PARENTHESIS
(cl-define-keysym #x002a "asterisk") ;U+002A ASTERISK
-(cl-define-keysym #x002b "plus") ;U+002B PLUS SIGN
-(cl-define-keysym #x002c "comma") ;U+002C COMMA
-(cl-define-keysym #x002d "minus") ;U+002D HYPHEN-MINUS
-(cl-define-keysym #x002e "period") ;U+002E FULL STOP
-(cl-define-keysym #x002f "slash") ;U+002F SOLIDUS
+(cl-define-keysym #x002b "plus") ;U+002B PLUS SIGN
+(cl-define-keysym #x002c "comma") ;U+002C COMMA
+(cl-define-keysym #x002d "minus") ;U+002D HYPHEN-MINUS
+(cl-define-keysym #x002e "period") ;U+002E FULL STOP
+(cl-define-keysym #x002f "slash") ;U+002F SOLIDUS
(cl-define-keysym #x0030 "0") ;U+0030 DIGIT ZERO
(cl-define-keysym #x0031 "1") ;U+0031 DIGIT ONE
(cl-define-keysym #x0032 "2") ;U+0032 DIGIT TWO
@@ -380,79 +380,79 @@
(cl-define-keysym #x0037 "7") ;U+0037 DIGIT SEVEN
(cl-define-keysym #x0038 "8") ;U+0038 DIGIT EIGHT
(cl-define-keysym #x0039 "9") ;U+0039 DIGIT NINE
-(cl-define-keysym #x003a "colon") ;U+003A COLON
+(cl-define-keysym #x003a "colon") ;U+003A COLON
(cl-define-keysym #x003b "semicolon") ;U+003B SEMICOLON
-(cl-define-keysym #x003c "less") ;U+003C LESS-THAN SIGN
-(cl-define-keysym #x003d "equal") ;U+003D EQUALS SIGN
+(cl-define-keysym #x003c "less") ;U+003C LESS-THAN SIGN
+(cl-define-keysym #x003d "equal") ;U+003D EQUALS SIGN
(cl-define-keysym #x003e "greater") ;U+003E GREATER-THAN SIGN
(cl-define-keysym #x003f "question") ;U+003F QUESTION MARK
(cl-define-keysym #x0040 "at") ;U+0040 COMMERCIAL AT
-(cl-define-keysym #x0041 "A") ;U+0041 LATIN CAPITAL LETTER A
-(cl-define-keysym #x0042 "B") ;U+0042 LATIN CAPITAL LETTER B
-(cl-define-keysym #x0043 "C") ;U+0043 LATIN CAPITAL LETTER C
-(cl-define-keysym #x0044 "D") ;U+0044 LATIN CAPITAL LETTER D
-(cl-define-keysym #x0045 "E") ;U+0045 LATIN CAPITAL LETTER E
-(cl-define-keysym #x0046 "F") ;U+0046 LATIN CAPITAL LETTER F
-(cl-define-keysym #x0047 "G") ;U+0047 LATIN CAPITAL LETTER G
-(cl-define-keysym #x0048 "H") ;U+0048 LATIN CAPITAL LETTER H
-(cl-define-keysym #x0049 "I") ;U+0049 LATIN CAPITAL LETTER I
-(cl-define-keysym #x004a "J") ;U+004A LATIN CAPITAL LETTER J
-(cl-define-keysym #x004b "K") ;U+004B LATIN CAPITAL LETTER K
-(cl-define-keysym #x004c "L") ;U+004C LATIN CAPITAL LETTER L
-(cl-define-keysym #x004d "M") ;U+004D LATIN CAPITAL LETTER M
-(cl-define-keysym #x004e "N") ;U+004E LATIN CAPITAL LETTER N
-(cl-define-keysym #x004f "O") ;U+004F LATIN CAPITAL LETTER O
-(cl-define-keysym #x0050 "P") ;U+0050 LATIN CAPITAL LETTER P
-(cl-define-keysym #x0051 "Q") ;U+0051 LATIN CAPITAL LETTER Q
-(cl-define-keysym #x0052 "R") ;U+0052 LATIN CAPITAL LETTER R
-(cl-define-keysym #x0053 "S") ;U+0053 LATIN CAPITAL LETTER S
-(cl-define-keysym #x0054 "T") ;U+0054 LATIN CAPITAL LETTER T
-(cl-define-keysym #x0055 "U") ;U+0055 LATIN CAPITAL LETTER U
-(cl-define-keysym #x0056 "V") ;U+0056 LATIN CAPITAL LETTER V
-(cl-define-keysym #x0057 "W") ;U+0057 LATIN CAPITAL LETTER W
-(cl-define-keysym #x0058 "X") ;U+0058 LATIN CAPITAL LETTER X
-(cl-define-keysym #x0059 "Y") ;U+0059 LATIN CAPITAL LETTER Y
-(cl-define-keysym #x005a "Z") ;U+005A LATIN CAPITAL LETTER Z
+(cl-define-keysym #x0041 "A") ;U+0041 LATIN CAPITAL LETTER A
+(cl-define-keysym #x0042 "B") ;U+0042 LATIN CAPITAL LETTER B
+(cl-define-keysym #x0043 "C") ;U+0043 LATIN CAPITAL LETTER C
+(cl-define-keysym #x0044 "D") ;U+0044 LATIN CAPITAL LETTER D
+(cl-define-keysym #x0045 "E") ;U+0045 LATIN CAPITAL LETTER E
+(cl-define-keysym #x0046 "F") ;U+0046 LATIN CAPITAL LETTER F
+(cl-define-keysym #x0047 "G") ;U+0047 LATIN CAPITAL LETTER G
+(cl-define-keysym #x0048 "H") ;U+0048 LATIN CAPITAL LETTER H
+(cl-define-keysym #x0049 "I") ;U+0049 LATIN CAPITAL LETTER I
+(cl-define-keysym #x004a "J") ;U+004A LATIN CAPITAL LETTER J
+(cl-define-keysym #x004b "K") ;U+004B LATIN CAPITAL LETTER K
+(cl-define-keysym #x004c "L") ;U+004C LATIN CAPITAL LETTER L
+(cl-define-keysym #x004d "M") ;U+004D LATIN CAPITAL LETTER M
+(cl-define-keysym #x004e "N") ;U+004E LATIN CAPITAL LETTER N
+(cl-define-keysym #x004f "O") ;U+004F LATIN CAPITAL LETTER O
+(cl-define-keysym #x0050 "P") ;U+0050 LATIN CAPITAL LETTER P
+(cl-define-keysym #x0051 "Q") ;U+0051 LATIN CAPITAL LETTER Q
+(cl-define-keysym #x0052 "R") ;U+0052 LATIN CAPITAL LETTER R
+(cl-define-keysym #x0053 "S") ;U+0053 LATIN CAPITAL LETTER S
+(cl-define-keysym #x0054 "T") ;U+0054 LATIN CAPITAL LETTER T
+(cl-define-keysym #x0055 "U") ;U+0055 LATIN CAPITAL LETTER U
+(cl-define-keysym #x0056 "V") ;U+0056 LATIN CAPITAL LETTER V
+(cl-define-keysym #x0057 "W") ;U+0057 LATIN CAPITAL LETTER W
+(cl-define-keysym #x0058 "X") ;U+0058 LATIN CAPITAL LETTER X
+(cl-define-keysym #x0059 "Y") ;U+0059 LATIN CAPITAL LETTER Y
+(cl-define-keysym #x005a "Z") ;U+005A LATIN CAPITAL LETTER Z
(cl-define-keysym #x005b "bracketleft") ;U+005B LEFT SQUARE BRACKET
(cl-define-keysym #x005c "backslash") ;U+005C REVERSE SOLIDUS
-(cl-define-keysym #x005d "bracketright") ;U+005D RIGHT SQUARE BRACKET
-(cl-define-keysym #x005e "asciicircum") ;U+005E CIRCUMFLEX ACCENT
-(cl-define-keysym #x005f "underscore") ;U+005F LOW LINE
-(cl-define-keysym #x0060 "grave") ;U+0060 GRAVE ACCENT
-(cl-define-keysym #x0060 "quoteleft") ;deprecated
-(cl-define-keysym #x0061 "a") ;U+0061 LATIN SMALL LETTER A
-(cl-define-keysym #x0062 "b") ;U+0062 LATIN SMALL LETTER B
-(cl-define-keysym #x0063 "c") ;U+0063 LATIN SMALL LETTER C
-(cl-define-keysym #x0064 "d") ;U+0064 LATIN SMALL LETTER D
-(cl-define-keysym #x0065 "e") ;U+0065 LATIN SMALL LETTER E
-(cl-define-keysym #x0066 "f") ;U+0066 LATIN SMALL LETTER F
-(cl-define-keysym #x0067 "g") ;U+0067 LATIN SMALL LETTER G
-(cl-define-keysym #x0068 "h") ;U+0068 LATIN SMALL LETTER H
-(cl-define-keysym #x0069 "i") ;U+0069 LATIN SMALL LETTER I
-(cl-define-keysym #x006a "j") ;U+006A LATIN SMALL LETTER J
-(cl-define-keysym #x006b "k") ;U+006B LATIN SMALL LETTER K
-(cl-define-keysym #x006c "l") ;U+006C LATIN SMALL LETTER L
-(cl-define-keysym #x006d "m") ;U+006D LATIN SMALL LETTER M
-(cl-define-keysym #x006e "n") ;U+006E LATIN SMALL LETTER N
-(cl-define-keysym #x006f "o") ;U+006F LATIN SMALL LETTER O
-(cl-define-keysym #x0070 "p") ;U+0070 LATIN SMALL LETTER P
-(cl-define-keysym #x0071 "q") ;U+0071 LATIN SMALL LETTER Q
-(cl-define-keysym #x0072 "r") ;U+0072 LATIN SMALL LETTER R
-(cl-define-keysym #x0073 "s") ;U+0073 LATIN SMALL LETTER S
-(cl-define-keysym #x0074 "t") ;U+0074 LATIN SMALL LETTER T
-(cl-define-keysym #x0075 "u") ;U+0075 LATIN SMALL LETTER U
-(cl-define-keysym #x0076 "v") ;U+0076 LATIN SMALL LETTER V
-(cl-define-keysym #x0077 "w") ;U+0077 LATIN SMALL LETTER W
-(cl-define-keysym #x0078 "x") ;U+0078 LATIN SMALL LETTER X
-(cl-define-keysym #x0079 "y") ;U+0079 LATIN SMALL LETTER Y
-(cl-define-keysym #x007a "z") ;U+007A LATIN SMALL LETTER Z
-(cl-define-keysym #x007b "braceleft") ;U+007B LEFT CURLY BRACKET
-(cl-define-keysym #x007c "bar") ;U+007C VERTICAL LINE
-(cl-define-keysym #x007d "braceright") ;U+007D RIGHT CURLY BRACKET
-(cl-define-keysym #x007e "asciitilde") ;U+007E TILDE
-(cl-define-keysym #x00a0 "nobreakspace") ;U+00A0 NO-BREAK SPACE
-(cl-define-keysym #x00a1 "exclamdown") ;U+00A1 INVERTED EXCLAMATION MARK
-(cl-define-keysym #x00a2 "cent") ;U+00A2 CENT SIGN
+(cl-define-keysym #x005d "bracketright") ;U+005D RIGHT SQUARE BRACKET
+(cl-define-keysym #x005e "asciicircum") ;U+005E CIRCUMFLEX ACCENT
+(cl-define-keysym #x005f "underscore") ;U+005F LOW LINE
+(cl-define-keysym #x0060 "grave") ;U+0060 GRAVE ACCENT
+(cl-define-keysym #x0060 "quoteleft") ;deprecated
+(cl-define-keysym #x0061 "a") ;U+0061 LATIN SMALL LETTER A
+(cl-define-keysym #x0062 "b") ;U+0062 LATIN SMALL LETTER B
+(cl-define-keysym #x0063 "c") ;U+0063 LATIN SMALL LETTER C
+(cl-define-keysym #x0064 "d") ;U+0064 LATIN SMALL LETTER D
+(cl-define-keysym #x0065 "e") ;U+0065 LATIN SMALL LETTER E
+(cl-define-keysym #x0066 "f") ;U+0066 LATIN SMALL LETTER F
+(cl-define-keysym #x0067 "g") ;U+0067 LATIN SMALL LETTER G
+(cl-define-keysym #x0068 "h") ;U+0068 LATIN SMALL LETTER H
+(cl-define-keysym #x0069 "i") ;U+0069 LATIN SMALL LETTER I
+(cl-define-keysym #x006a "j") ;U+006A LATIN SMALL LETTER J
+(cl-define-keysym #x006b "k") ;U+006B LATIN SMALL LETTER K
+(cl-define-keysym #x006c "l") ;U+006C LATIN SMALL LETTER L
+(cl-define-keysym #x006d "m") ;U+006D LATIN SMALL LETTER M
+(cl-define-keysym #x006e "n") ;U+006E LATIN SMALL LETTER N
+(cl-define-keysym #x006f "o") ;U+006F LATIN SMALL LETTER O
+(cl-define-keysym #x0070 "p") ;U+0070 LATIN SMALL LETTER P
+(cl-define-keysym #x0071 "q") ;U+0071 LATIN SMALL LETTER Q
+(cl-define-keysym #x0072 "r") ;U+0072 LATIN SMALL LETTER R
+(cl-define-keysym #x0073 "s") ;U+0073 LATIN SMALL LETTER S
+(cl-define-keysym #x0074 "t") ;U+0074 LATIN SMALL LETTER T
+(cl-define-keysym #x0075 "u") ;U+0075 LATIN SMALL LETTER U
+(cl-define-keysym #x0076 "v") ;U+0076 LATIN SMALL LETTER V
+(cl-define-keysym #x0077 "w") ;U+0077 LATIN SMALL LETTER W
+(cl-define-keysym #x0078 "x") ;U+0078 LATIN SMALL LETTER X
+(cl-define-keysym #x0079 "y") ;U+0079 LATIN SMALL LETTER Y
+(cl-define-keysym #x007a "z") ;U+007A LATIN SMALL LETTER Z
+(cl-define-keysym #x007b "braceleft") ;U+007B LEFT CURLY BRACKET
+(cl-define-keysym #x007c "bar") ;U+007C VERTICAL LINE
+(cl-define-keysym #x007d "braceright") ;U+007D RIGHT CURLY BRACKET
+(cl-define-keysym #x007e "asciitilde") ;U+007E TILDE
+(cl-define-keysym #x00a0 "nobreakspace") ;U+00A0 NO-BREAK SPACE
+(cl-define-keysym #x00a1 "exclamdown") ;U+00A1 INVERTED EXCLAMATION MARK
+(cl-define-keysym #x00a2 "cent") ;U+00A2 CENT SIGN
(cl-define-keysym #x00a3 "sterling") ;U+00A3 POUND SIGN
(cl-define-keysym #x00a4 "currency") ;U+00A4 CURRENCY SIGN
(cl-define-keysym #x00a5 "yen") ;U+00A5 YEN SIGN
@@ -461,630 +461,630 @@
(cl-define-keysym #x00a8 "diaeresis") ;U+00A8 DIAERESIS
(cl-define-keysym #x00a9 "copyright") ;U+00A9 COPYRIGHT SIGN
(cl-define-keysym #x00aa "ordfeminine") ;U+00AA FEMININE ORDINAL INDICATOR
-(cl-define-keysym #x00ab "guillemotleft") ;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
-(cl-define-keysym #x00ac "notsign") ;U+00AC NOT SIGN
-(cl-define-keysym #x00ad "hyphen") ;U+00AD SOFT HYPHEN
-(cl-define-keysym #x00ae "registered") ;U+00AE REGISTERED SIGN
-(cl-define-keysym #x00af "macron") ;U+00AF MACRON
-(cl-define-keysym #x00b0 "degree") ;U+00B0 DEGREE SIGN
-(cl-define-keysym #x00b1 "plusminus") ;U+00B1 PLUS-MINUS SIGN
-(cl-define-keysym #x00b2 "twosuperior") ;U+00B2 SUPERSCRIPT TWO
-(cl-define-keysym #x00b3 "threesuperior") ;U+00B3 SUPERSCRIPT THREE
-(cl-define-keysym #x00b4 "acute") ;U+00B4 ACUTE ACCENT
-(cl-define-keysym #x00b5 "mu") ;U+00B5 MICRO SIGN
-(cl-define-keysym #x00b6 "paragraph") ;U+00B6 PILCROW SIGN
-(cl-define-keysym #x00b7 "periodcentered") ;U+00B7 MIDDLE DOT
-(cl-define-keysym #x00b8 "cedilla") ;U+00B8 CEDILLA
-(cl-define-keysym #x00b9 "onesuperior") ;U+00B9 SUPERSCRIPT ONE
-(cl-define-keysym #x00ba "masculine") ;U+00BA MASCULINE ORDINAL INDICATOR
-(cl-define-keysym #x00bb "guillemotright") ;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
-(cl-define-keysym #x00bc "onequarter") ;U+00BC VULGAR FRACTION ONE QUARTER
-(cl-define-keysym #x00bd "onehalf") ;U+00BD VULGAR FRACTION ONE HALF
-(cl-define-keysym #x00be "threequarters") ;U+00BE VULGAR FRACTION THREE QUARTERS
-(cl-define-keysym #x00bf "questiondown") ;U+00BF INVERTED QUESTION MARK
-(cl-define-keysym #x00c0 "Agrave") ;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE
-(cl-define-keysym #x00c1 "Aacute") ;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE
+(cl-define-keysym #x00ab "guillemotleft") ;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+(cl-define-keysym #x00ac "notsign") ;U+00AC NOT SIGN
+(cl-define-keysym #x00ad "hyphen") ;U+00AD SOFT HYPHEN
+(cl-define-keysym #x00ae "registered") ;U+00AE REGISTERED SIGN
+(cl-define-keysym #x00af "macron") ;U+00AF MACRON
+(cl-define-keysym #x00b0 "degree") ;U+00B0 DEGREE SIGN
+(cl-define-keysym #x00b1 "plusminus") ;U+00B1 PLUS-MINUS SIGN
+(cl-define-keysym #x00b2 "twosuperior") ;U+00B2 SUPERSCRIPT TWO
+(cl-define-keysym #x00b3 "threesuperior") ;U+00B3 SUPERSCRIPT THREE
+(cl-define-keysym #x00b4 "acute") ;U+00B4 ACUTE ACCENT
+(cl-define-keysym #x00b5 "mu") ;U+00B5 MICRO SIGN
+(cl-define-keysym #x00b6 "paragraph") ;U+00B6 PILCROW SIGN
+(cl-define-keysym #x00b7 "periodcentered") ;U+00B7 MIDDLE DOT
+(cl-define-keysym #x00b8 "cedilla") ;U+00B8 CEDILLA
+(cl-define-keysym #x00b9 "onesuperior") ;U+00B9 SUPERSCRIPT ONE
+(cl-define-keysym #x00ba "masculine") ;U+00BA MASCULINE ORDINAL INDICATOR
+(cl-define-keysym #x00bb "guillemotright") ;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+(cl-define-keysym #x00bc "onequarter") ;U+00BC VULGAR FRACTION ONE QUARTER
+(cl-define-keysym #x00bd "onehalf") ;U+00BD VULGAR FRACTION ONE HALF
+(cl-define-keysym #x00be "threequarters") ;U+00BE VULGAR FRACTION THREE QUARTERS
+(cl-define-keysym #x00bf "questiondown") ;U+00BF INVERTED QUESTION MARK
+(cl-define-keysym #x00c0 "Agrave") ;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE
+(cl-define-keysym #x00c1 "Aacute") ;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE
(cl-define-keysym #x00c2 "Acircumflex") ;U+00C2 LATIN CAPITAL LETTER A WITH CIRCUMFLEX
-(cl-define-keysym #x00c3 "Atilde") ;U+00C3 LATIN CAPITAL LETTER A WITH TILDE
-(cl-define-keysym #x00c4 "Adiaeresis") ;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS
-(cl-define-keysym #x00c5 "Aring") ;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE
-(cl-define-keysym #x00c6 "AE") ;U+00C6 LATIN CAPITAL LETTER AE
-(cl-define-keysym #x00c7 "Ccedilla") ;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA
-(cl-define-keysym #x00c8 "Egrave") ;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE
-(cl-define-keysym #x00c9 "Eacute") ;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE
+(cl-define-keysym #x00c3 "Atilde") ;U+00C3 LATIN CAPITAL LETTER A WITH TILDE
+(cl-define-keysym #x00c4 "Adiaeresis") ;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS
+(cl-define-keysym #x00c5 "Aring") ;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE
+(cl-define-keysym #x00c6 "AE") ;U+00C6 LATIN CAPITAL LETTER AE
+(cl-define-keysym #x00c7 "Ccedilla") ;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA
+(cl-define-keysym #x00c8 "Egrave") ;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE
+(cl-define-keysym #x00c9 "Eacute") ;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE
(cl-define-keysym #x00ca "Ecircumflex") ;U+00CA LATIN CAPITAL LETTER E WITH CIRCUMFLEX
-(cl-define-keysym #x00cb "Ediaeresis") ;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS
-(cl-define-keysym #x00cc "Igrave") ;U+00CC LATIN CAPITAL LETTER I WITH GRAVE
-(cl-define-keysym #x00cd "Iacute") ;U+00CD LATIN CAPITAL LETTER I WITH ACUTE
+(cl-define-keysym #x00cb "Ediaeresis") ;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS
+(cl-define-keysym #x00cc "Igrave") ;U+00CC LATIN CAPITAL LETTER I WITH GRAVE
+(cl-define-keysym #x00cd "Iacute") ;U+00CD LATIN CAPITAL LETTER I WITH ACUTE
(cl-define-keysym #x00ce "Icircumflex") ;U+00CE LATIN CAPITAL LETTER I WITH CIRCUMFLEX
-(cl-define-keysym #x00cf "Idiaeresis") ;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS
-(cl-define-keysym #x00d0 "ETH") ;U+00D0 LATIN CAPITAL LETTER ETH
-(cl-define-keysym #x00d0 "Eth") ;deprecated
-(cl-define-keysym #x00d1 "Ntilde") ;U+00D1 LATIN CAPITAL LETTER N WITH TILDE
-(cl-define-keysym #x00d2 "Ograve") ;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE
-(cl-define-keysym #x00d3 "Oacute") ;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE
+(cl-define-keysym #x00cf "Idiaeresis") ;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS
+(cl-define-keysym #x00d0 "ETH") ;U+00D0 LATIN CAPITAL LETTER ETH
+(cl-define-keysym #x00d0 "Eth") ;deprecated
+(cl-define-keysym #x00d1 "Ntilde") ;U+00D1 LATIN CAPITAL LETTER N WITH TILDE
+(cl-define-keysym #x00d2 "Ograve") ;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE
+(cl-define-keysym #x00d3 "Oacute") ;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE
(cl-define-keysym #x00d4 "Ocircumflex") ;U+00D4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX
-(cl-define-keysym #x00d5 "Otilde") ;U+00D5 LATIN CAPITAL LETTER O WITH TILDE
-(cl-define-keysym #x00d6 "Odiaeresis") ;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS
+(cl-define-keysym #x00d5 "Otilde") ;U+00D5 LATIN CAPITAL LETTER O WITH TILDE
+(cl-define-keysym #x00d6 "Odiaeresis") ;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS
(cl-define-keysym #x00d7 "multiply") ;U+00D7 MULTIPLICATION SIGN
-(cl-define-keysym #x00d8 "Oslash") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
-(cl-define-keysym #x00d8 "Ooblique") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
-(cl-define-keysym #x00d9 "Ugrave") ;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE
-(cl-define-keysym #x00da "Uacute") ;U+00DA LATIN CAPITAL LETTER U WITH ACUTE
+(cl-define-keysym #x00d8 "Oslash") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
+(cl-define-keysym #x00d8 "Ooblique") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE
+(cl-define-keysym #x00d9 "Ugrave") ;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE
+(cl-define-keysym #x00da "Uacute") ;U+00DA LATIN CAPITAL LETTER U WITH ACUTE
[2215 lines skipped]
--- /project/clfswm/cvsroot/clfswm/load.lisp 2008/01/03 20:31:24 1.4
+++ /project/clfswm/cvsroot/clfswm/load.lisp 2008/02/24 20:53:37 1.5
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Dec 21 23:00:32 2007
+;;; #Date#: Wed Feb 6 23:39:49 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: System loading functions
@@ -38,6 +38,9 @@
(require :asdf)
#+SBCL
+(require :sb-posix)
+
+#+SBCL
(require :clx)
#-ASDF
@@ -53,4 +56,4 @@
(in-package :clfswm)
-(clfswm:main)
+(clfswm:main ":1")
--- /project/clfswm/cvsroot/clfswm/netwm-util.lisp 2007/12/21 22:01:14 1.3
+++ /project/clfswm/cvsroot/clfswm/netwm-util.lisp 2008/02/24 20:53:37 1.4
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Dec 21 23:00:38 2007
+;;; #Date#: Wed Feb 20 23:26:21 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: NetWM functions
@@ -31,36 +31,36 @@
;;; Client List functions
(defun netwm-set-client-list (id-list)
- (change-property *root* :_NET_CLIENT_LIST id-list :window 32))
+ (xlib:change-property *root* :_NET_CLIENT_LIST id-list :window 32))
(defun netwm-get-client-list ()
- (get-property *root* :_NET_CLIENT_LIST))
+ (xlib:get-property *root* :_NET_CLIENT_LIST))
(defun netwm-add-in-client-list (window)
(let ((last-list (netwm-get-client-list)))
- (pushnew (window-id window) last-list)
+ (pushnew (xlib:window-id window) last-list)
(netwm-set-client-list last-list)))
(defun netwm-remove-in-client-list (window)
- (netwm-set-client-list (remove (window-id window) (netwm-get-client-list))))
+ (netwm-set-client-list (remove (xlib:window-id window) (netwm-get-client-list))))
-
-;;; Desktop functions
+
+;;; Desktop functions ;; +PHIL
(defun netwm-update-desktop-property ()
- (change-property *root* :_NET_NUMBER_OF_DESKTOPS
- (list (length *workspace-list*)) :cardinal 32)
- (change-property *root* :_NET_DESKTOP_GEOMETRY
- (list (screen-width *screen*)
- (screen-height *screen*))
- :cardinal 32)
- (change-property *root* :_NET_DESKTOP_VIEWPORT
- (list 0 0) :cardinal 32)
- (change-property *root* :_NET_CURRENT_DESKTOP
- (list 1) :cardinal 32)
- ;;; TODO
- ;;(change-property *root* :_NET_DESKTOP_NAMES
- ;; (list "toto" "klm" "poi") :string 8 :transform #'char->card8))
+ ;; (xlib:change-property *root* :_NET_NUMBER_OF_DESKTOPS
+ ;; (list (length *workspace-list*)) :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_DESKTOP_GEOMETRY
+ ;; (list (xlib:screen-width *screen*)
+ ;; (xlib:screen-height *screen*))
+ ;; :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_DESKTOP_VIEWPORT
+ ;; (list 0 0) :cardinal 32)
+ ;; (xlib:change-property *root* :_NET_CURRENT_DESKTOP
+ ;; (list 1) :cardinal 32)
+;;; TODO
+ ;;(xlib:change-property *root* :_NET_DESKTOP_NAMES
+ ;; (list "toto" "klm" "poi") :string 8 :transform #'xlib:char->card8))
)
@@ -71,20 +71,25 @@
"Set NETWM properties on the root window of the specified screen.
FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
;; _NET_SUPPORTED
- (change-property *root* :_NET_SUPPORTED
- (mapcar (lambda (a)
- (xlib:intern-atom *display* a))
- (append +netwm-supported+
- (mapcar 'car +netwm-window-types+)))
- :atom 32)
+ (xlib:change-property *root* :_NET_SUPPORTED
+ (mapcar (lambda (a)
+ (xlib:intern-atom *display* a))
+ (append +netwm-supported+
+ (mapcar 'car +netwm-window-types+)))
+ :atom 32)
;; _NET_SUPPORTING_WM_CHECK
- (change-property *root* :_NET_SUPPORTING_WM_CHECK
- (list *no-focus-window*) :window 32
- :transform #'drawable-id)
- (change-property *no-focus-window* :_NET_SUPPORTING_WM_CHECK
- (list *no-focus-window*) :window 32
- :transform #'drawable-id)
- (change-property *no-focus-window* :_NET_WM_NAME
- "clfswm"
- :string 8 :transform #'char->card8)
- (netwm-update-desktop-property))
\ No newline at end of file
+ (xlib:change-property *root* :_NET_SUPPORTING_WM_CHECK
+ (list *no-focus-window*) :window 32
+ :transform #'xlib:drawable-id)
+ (xlib:change-property *no-focus-window* :_NET_SUPPORTING_WM_CHECK
+ (list *no-focus-window*) :window 32
+ :transform #'xlib:drawable-id)
+ (xlib:change-property *no-focus-window* :_NET_WM_NAME
+ "clfswm"
+ :string 8 :transform #'xlib:char->card8)
+ (netwm-update-desktop-property))
+
+
+
+
+
--- /project/clfswm/cvsroot/clfswm/package.lisp 2008/01/01 19:13:45 1.9
+++ /project/clfswm/cvsroot/clfswm/package.lisp 2008/02/24 20:53:37 1.10
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Jan 1 20:11:50 2008
+;;; #Date#: Sun Feb 24 21:35:31 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Package definition
@@ -28,15 +28,12 @@
(in-package :cl-user)
(defpackage clfswm
- (:use :common-lisp :xlib :my-html :tools)
+ (:use :common-lisp :my-html :tools)
;;(:shadow :defun)
(:export :main))
(in-package :clfswm)
-(defstruct workspace number group-list)
-(defstruct group x y width height window-list fullscreenp)
-
(defparameter *display* nil)
(defparameter *screen* nil)
@@ -44,12 +41,56 @@
(defparameter *no-focus-window* nil)
(defparameter *root-gc* nil)
+(defparameter *default-font* nil)
+;;(defparameter *default-font-string* "9x15")
+(defparameter *default-font-string* "fixed")
+
+
+(defparameter *child-selection* nil)
+
+(defparameter *current-group-number* -1)
+
+(defparameter *layout-list* nil)
+
+
+;;(defstruct group (number (incf *current-group-number*)) name
+;; (x 0) (y 0) (w 1) (h 1) rx ry rw rh
+;; layout window gc child)
+
+(defclass group ()
+ ((name :initarg :name :accessor group-name :initform nil)
+ (number :initarg :number :accessor group-number
+ :initform (incf *current-group-number*))
+ ;;; Float size - Manipulate only this variable and not real size
+ (x :initarg :x :accessor group-x :initform 0.1)
+ (y :initarg :y :accessor group-y :initform 0.1)
+ (w :initarg :w :accessor group-w :initform 0.8)
+ (h :initarg :h :accessor group-h :initform 0.8)
+ ;;; Real size (integer) in screen size - Don't set directly this variables
+ ;;; they may be recalculated by the layout manager.
+ (rx :initarg :rx :accessor group-rx :initform 0)
+ (ry :initarg :ry :accessor group-ry :initform 0)
+ (rw :initarg :rw :accessor group-rw :initform 800)
+ (rh :initarg :rh :accessor group-rh :initform 600)
+ (layout :initarg :layout :accessor group-layout :initform nil)
+ (window :initarg :window :accessor group-window :initform nil)
+ (gc :initarg :gc :accessor group-gc :initform nil)
+ (child :initarg :child :accessor group-child :initform nil)
+ (data :initarg :data :accessor group-data
+ :initform (list '(:tile-size 0.8) '(:tile-space-size 0.1))
+ :documentation "An assoc list to store additional data")))
+
-(defparameter *default-group* nil)
+(defparameter *root-group* nil
+ "Root of the root - ie the root group")
+(defparameter *current-root* nil
+ "The current fullscreen maximized child")
+(defparameter *current-child* nil
+ "The current child with the focus")
+
+(defparameter *show-root-group-p* nil)
-(defparameter *workspace-list* nil)
-(defparameter *current-workspace-number* 0)
(defparameter *main-keys* (make-hash-table :test 'equal))
(defparameter *second-keys* (make-hash-table :test 'equal))
@@ -87,8 +128,12 @@
;;;
;;; See clfswm.lisp for hooks examples.
+;;; Init hook. This hook is run just after the first root group is created
+(defparameter *init-hook* nil)
+
;;; Main mode hooks (set in clfswm.lisp)
(defparameter *button-press-hook* nil)
+(defparameter *button-motion-notify-hook* nil)
(defparameter *key-press-hook* nil)
(defparameter *configure-request-hook* nil)
(defparameter *configure-notify-hook* nil)
@@ -157,5 +202,5 @@
;; (error (c)
;; (format t "New defun: Error in ~A : ~A~%" ',name c)
;; (format t "Root tree=~A~%All windows=~A~%"
-;; (query-tree *root*) (get-all-windows))
+;; (xlib:query-tree *root*) (get-all-windows))
;; (force-output))))))
--- /project/clfswm/cvsroot/clfswm/tools.lisp 2008/01/03 22:15:48 1.5
+++ /project/clfswm/cvsroot/clfswm/tools.lisp 2008/02/24 20:53:37 1.6
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 22:53:59 2008
+;;; #Date#: Tue Feb 12 14:03:59 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: General tools
@@ -30,7 +30,10 @@
(defpackage tools
(:use common-lisp)
- (:export :dbg
+ (:export :it
+ :awhen
+ :aif
+ :dbg
:dbgnl
:setf/=
:create-symbol
@@ -81,6 +84,13 @@
+(defmacro awhen (test &body body)
+ `(let ((it ,test))
+ (when it
+ , at body)))
+
+(defmacro aif (test then &optional else)
+ `(let ((it ,test)) (if it ,then ,else)))
;;;,-----
@@ -92,36 +102,36 @@
(defmacro dbg (&rest forms)
`(progn
- ,@(mapcar #'(lambda (form)
- (typecase form
- (string `(setf *%dbg-name%* ,form))
- (number `(setf *%dbg-count%* ,form))))
- forms)
- (format t "~&DEBUG[~A - ~A] " (incf *%dbg-count%*) *%dbg-name%*)
- ,@(mapcar #'(lambda (form)
- (typecase form
- ((or string number) nil)
- (t `(format t "~A=~S " ',form ,form))))
- forms)
- (format t "~%")
- (force-output)
- , at forms))
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ (string `(setf *%dbg-name%* ,form))
+ (number `(setf *%dbg-count%* ,form))))
+ forms)
+ (format t "~&DEBUG[~A - ~A] " (incf *%dbg-count%*) *%dbg-name%*)
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ ((or string number) nil)
+ (t `(format t "~A=~S " ',form ,form))))
+ forms)
+ (format t "~%")
+ (force-output)
+ , at forms))
(defmacro dbgnl (&rest forms)
`(progn
- ,@(mapcar #'(lambda (form)
- (typecase form
- (string `(setf *%dbg-name%* ,form))
- (number `(setf *%dbg-count%* ,form))))
- forms)
- (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
- ,@(mapcar #'(lambda (form)
- (typecase form
- ((or string number) nil)
- (t `(format t " - ~A=~S~%" ',form ,form))))
- forms)
- (force-output)
- , at forms))
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ (string `(setf *%dbg-name%* ,form))
+ (number `(setf *%dbg-count%* ,form))))
+ forms)
+ (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ ((or string number) nil)
+ (t `(format t " - ~A=~S~%" ',form ,form))))
+ forms)
+ (force-output)
+ , at forms))
@@ -147,10 +157,10 @@
(defun split-string (string &optional (separator #\Space))
"Return a list from a string splited at each separators"
(loop for i = 0 then (1+ j)
- as j = (position separator string :start i)
- as sub = (subseq string i j)
- unless (string= sub "") collect sub
- while j))
+ as j = (position separator string :start i)
+ as sub = (subseq string i j)
+ unless (string= sub "") collect sub
+ while j))
(defun expand-newline (list)
@@ -202,13 +212,13 @@
(zerop (or (search word string) -1)))
-(defun find-free-number (l) ; stolen from stumpwm - thanks
+(defun find-free-number (l) ; stolen from stumpwm - thanks
"Return a number that is not in the list l."
(let* ((nums (sort l #'<))
(new-num (loop for n from 0 to (or (car (last nums)) 0)
- for i in nums
- when (/= n i)
- do (return n))))
+ for i in nums
+ when (/= n i)
+ do (return n))))
(if new-num
new-num
;; there was no space between the numbers, so use the last + 1
@@ -230,21 +240,21 @@
(dolist (a args)
(setf fullstring (concatenate 'string fullstring " " a)))
#+:cmu (let ((proc (ext:run-program program args :input :stream
- :output :stream :wait wt)))
+ :output :stream :wait wt)))
(unless proc
(error "Cannot create process."))
(make-two-way-stream
(ext:process-output proc)
(ext:process-input proc)))
#+:clisp (let ((proc (ext:run-program program :arguments args
- :input :stream :output
- :stream :wait (or wt t))))
+ :input :stream :output
+ :stream :wait (or wt t))))
(unless proc
(error "Cannot create process."))
proc)
#+:sbcl (let ((proc (sb-ext:run-program program args :input
- :stream :output
- :stream :wait wt)))
+ :stream :output
+ :stream :wait wt)))
(unless proc
(error "Cannot create process."))
(make-two-way-stream
@@ -260,8 +270,8 @@
#+:ecl(ext:run-program program args :input :stream :output :stream
:error :output)
#+:openmcl (let ((proc (ccl:run-program program args :input
- :stream :output
- :stream :wait wt)))
+ :stream :output
+ :stream :wait wt)))
(unless proc
(error "Cannot create process."))
(make-two-way-stream
@@ -299,7 +309,7 @@
#+clisp (setf (ext:getenv (string var)) (string val))
#+(or cmu scl)
(let ((cell (assoc (string var) ext:*environment-list* :test #'equalp
- :key #'string)))
+ :key #'string)))
(if cell
(setf (cdr cell) (string val))
(push (cons (intern (string var) "KEYWORD") (string val))
@@ -392,14 +402,14 @@
(defun ushell-loop (&optional (shell-fun #'ushell))
(loop
- (format t "UNI-SHELL> ")
- (let* ((line (read-line)))
- (cond ((zerop (or (search "quit" line) -1)) (return))
- ((zerop (or (position #\! line) -1))
- (funcall shell-fun (subseq line 1)))
- (t (format t "~{~A~^ ;~%~}~%"
- (multiple-value-list
- (ignore-errors (eval (read-from-string line))))))))))
+ (format t "UNI-SHELL> ")
+ (let* ((line (read-line)))
+ (cond ((zerop (or (search "quit" line) -1)) (return))
+ ((zerop (or (position #\! line) -1))
+ (funcall shell-fun (subseq line 1)))
+ (t (format t "~{~A~^ ;~%~}~%"
+ (multiple-value-list
+ (ignore-errors (eval (read-from-string line))))))))))
@@ -425,10 +435,10 @@
(index (position split-char str :start start)
(position split-char str :start start))
(accum nil))
- ((null index)
- (unless (string= (subseq str start) "")
- (push (subseq str start) accum))
- (nreverse accum))
+ ((null index)
+ (unless (string= (subseq str start) "")
+ (push (subseq str start) accum))
+ (nreverse accum))
(when (/= start index)
(push (subseq str start index) accum))))
@@ -442,10 +452,10 @@
(if ret
(if (< pos ret)
pos
- ret)
- pos)
- ret)))
- ((null char) ret)))
+ ret)
+ pos)
+ ret)))
+ ((null char) ret)))
;;;(defun near-position2 (chars str &key (start 0))
@@ -466,10 +476,10 @@
(index (near-position split-chars str :start start)
(near-position split-chars str :start start))
(accum nil))
- ((null index)
- (unless (string= (subseq str start) "")
- (push (subseq str start) accum))
- (nreverse accum))
+ ((null index)
+ (unless (string= (subseq str start) "")
+ (push (subseq str start) accum))
+ (nreverse accum))
(let ((retstr (subseq str start (if preserve (1+ index) index))))
(unless (string= retstr "")
(push retstr accum)))))
@@ -596,7 +606,7 @@
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun find-string (substr str &key (start 0) (end nil)
- (test nil) (ignore-case nil))
+ (test nil) (ignore-case nil))
"Find substr in str. Return begin and end of substr in str as two values.
Start and end set the findinq region. Ignore-case make find-string case
insensitive.
@@ -613,7 +623,7 @@
(do ((done nil))
(done (if (functionp test)
(funcall test str pos1 pos2)
- (values pos1 pos2)))
+ (values pos1 pos2)))
(setq pos1 (position (aref substr 0) str :start (+ pos1 1) :end end))
(unless pos1
(return-from find-string nil))
@@ -624,16 +634,16 @@
(defun find-all-strings (substr str &key (start 0) (end nil)
- (test nil) (ignore-case nil))
+ (test nil) (ignore-case nil))
"Find all substr in str. Parameters are the same as find-string.
Return a list with all begin and end positions of substr in str
ie: '((pos1.1 pos1.2) (pos2.1 pos2.2))..."
(do ((pos (multiple-value-list
(find-string substr str :start start :end end
- :test test :ignore-case ignore-case))
+ :test test :ignore-case ignore-case))
(multiple-value-list
(find-string substr str :start (second pos) :end end
- :test test :ignore-case ignore-case)))
+ :test test :ignore-case ignore-case)))
(accum nil))
((equal pos '(nil)) (nreverse accum))
(push pos accum)))
@@ -641,7 +651,7 @@
(defun subst-strings (new substr str &key (start 0) (end nil)
- (test nil) (ignore-case nil))
+ (test nil) (ignore-case nil))
"Substitute all substr strings in str with new.
New must be a string or a function witch takes str pos1 pos2
as parameters and return a string to replace substr"
@@ -664,20 +674,20 @@
(subseq str pos1 pos2)
(if (functionp new)
(funcall new str pos2 newpos)
- new)))
+ new)))
(setq pos1 (if (and newpos (<= newpos end))
newpos
- end)))
- (progn
- (setq outstr (concatenate 'string
- outstr (subseq str pos1)))
- (setq done t))))))
+ end)))
+ (progn
+ (setq outstr (concatenate 'string
+ outstr (subseq str pos1)))
+ (setq done t))))))
(defun my-find-string-test (str pos1 pos2)
(multiple-value-bind
- (npos1 npos2)
+ (npos1 npos2)
(find-string "=>" str :start pos2)
(declare (ignore npos1))
(values pos1 npos2)))
@@ -699,7 +709,7 @@
(format t "[3] Find with test (ie '<=.*=>'): ~A~%"
(multiple-value-bind
- (pos1 pos2)
+ (pos1 pos2)
(find-string "<=" str :test #'my-find-string-test)
(subseq str pos1 pos2)))
@@ -731,7 +741,7 @@
"<=" str
:test #'(lambda (str pos1 pos2)
(multiple-value-bind
- (npos1 npos2)
+ (npos1 npos2)
(find-string "=>" str :start pos2)
(declare (ignore npos1))
(values pos1 npos2)))))))
--- /project/clfswm/cvsroot/clfswm/xlib-util.lisp 2008/01/03 20:31:24 1.5
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp 2008/02/24 20:53:37 1.6
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 17:50:59 2008
+;;; #Date#: Sun Feb 24 11:24:46 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility functions
@@ -38,7 +38,10 @@
:property-change
:colormap-change
:focus-change
- :enter-window)
+ :enter-window
+ :exposure)
+ ;;:button-press
+ ;;:button-release)
"The events to listen for on managed windows.")
@@ -67,20 +70,53 @@
Include only those we are ready to support.")
-(defun set-window-state (win state)
- "Set the state (iconic, normal, withdrawn) of a window."
- (change-property win
- :WM_STATE
- (list state)
- :WM_STATE
- 32))
+(defmacro with-xlib-protect (&body body)
+ "Prevent Xlib errors"
+ `(handler-case
+ (progn
+ , at body)
+ ((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
+ (declare (ignore c)))))
+
+
+
+(defun parse-display-string (display)
+ "Parse an X11 DISPLAY string and return the host and display from it."
+ (let* ((colon (position #\: display))
+ (host (subseq display 0 colon))
+ (rest (subseq display (1+ colon)))
+ (dot (position #\. rest))
+ (num (parse-integer (subseq rest 0 dot))))
+ (values host num)))
+
+
+(defun banish-pointer ()
+ "Move the pointer to the lower right corner of the screen"
+ (xlib:warp-pointer *root*
+ (1- (xlib:screen-width *screen*))
+ (1- (xlib:screen-height *screen*))))
+
+
+
+
(defun window-state (win)
"Get the state (iconic, normal, withdraw of a window."
- (first (get-property win :WM_STATE)))
+ (first (xlib:get-property win :WM_STATE)))
+
+
+(defun set-window-state (win state)
+ "Set the state (iconic, normal, withdrawn) of a window."
+ (xlib:change-property win
+ :WM_STATE
+ (list state)
+ :WM_STATE
+ 32))
(defsetf window-state set-window-state)
+
+
(defun window-hidden-p (window)
(eql (window-state window) +iconic-state+))
@@ -88,35 +124,142 @@
(defun unhide-window (window)
(when window
- (handler-case
- (progn
- (map-window window)
- (setf (window-state window) +normal-state+))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Unhide window" window c)))))
+ (with-xlib-protect
+ (xlib:map-window window)
+ (setf (window-state window) +normal-state+
+ (xlib:window-event-mask window) *window-events*))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;;(defconstant +exwm-atoms+
+;; (list "_NET_SUPPORTED" "_NET_CLIENT_LIST"
+;; "_NET_CLIENT_LIST_STACKING" "_NET_NUMBER_OF_DESKTOPS"
+;; "_NET_CURRENT_DESKTOP" "_NET_DESKTOP_GEOMETRY"
+;; "_NET_DESKTOP_VIEWPORT" "_NET_DESKTOP_NAMES"
+;; "_NET_ACTIVE_WINDOW" "_NET_WORKAREA"
+;; "_NET_SUPPORTING_WM_CHECK" "_NET_VIRTUAL_ROOTS"
+;; "_NET_DESKTOP_LAYOUT"
+;;
+;; "_NET_RESTACK_WINDOW" "_NET_REQUEST_FRAME_EXTENTS"
+;; "_NET_MOVERESIZE_WINDOW" "_NET_CLOSE_WINDOW"
+;; "_NET_WM_MOVERESIZE"
+;;
+;; "_NET_WM_SYNC_REQUEST" "_NET_WM_PING"
+;;
+;; "_NET_WM_NAME" "_NET_WM_VISIBLE_NAME"
+;; "_NET_WM_ICON_NAME" "_NET_WM_VISIBLE_ICON_NAME"
+;; "_NET_WM_DESKTOP" "_NET_WM_WINDOW_TYPE"
+;; "_NET_WM_STATE" "_NET_WM_STRUT"
+;; "_NET_WM_ICON_GEOMETRY" "_NET_WM_ICON"
+;; "_NET_WM_PID" "_NET_WM_HANDLED_ICONS"
+;; "_NET_WM_USER_TIME" "_NET_FRAME_EXTENTS"
+;; ;; "_NET_WM_MOVE_ACTIONS"
+;;
+;; "_NET_WM_WINDOW_TYPE_DESKTOP" "_NET_WM_STATE_MODAL"
+;; "_NET_WM_WINDOW_TYPE_DOCK" "_NET_WM_STATE_STICKY"
+;; "_NET_WM_WINDOW_TYPE_TOOLBAR" "_NET_WM_STATE_MAXIMIZED_VERT"
+;; "_NET_WM_WINDOW_TYPE_MENU" "_NET_WM_STATE_MAXIMIZED_HORZ"
+;; "_NET_WM_WINDOW_TYPE_UTILITY" "_NET_WM_STATE_SHADED"
+;; "_NET_WM_WINDOW_TYPE_SPLASH" "_NET_WM_STATE_SKIP_TASKBAR"
+;; "_NET_WM_WINDOW_TYPE_DIALOG" "_NET_WM_STATE_SKIP_PAGER"
+;; "_NET_WM_WINDOW_TYPE_NORMAL" "_NET_WM_STATE_HIDDEN"
+;; "_NET_WM_STATE_FULLSCREEN"
+;; "_NET_WM_STATE_ABOVE"
+;; "_NET_WM_STATE_BELOW"
+;; "_NET_WM_STATE_DEMANDS_ATTENTION"
+;;
+;; "_NET_WM_ALLOWED_ACTIONS"
+;; "_NET_WM_ACTION_MOVE"
+;; "_NET_WM_ACTION_RESIZE"
+;; "_NET_WM_ACTION_SHADE"
+;; "_NET_WM_ACTION_STICK"
+;; "_NET_WM_ACTION_MAXIMIZE_HORZ"
+;; "_NET_WM_ACTION_MAXIMIZE_VERT"
+;; "_NET_WM_ACTION_FULLSCREEN"
+;; "_NET_WM_ACTION_CHANGE_DESKTOP"
+;; "_NET_WM_ACTION_CLOSE"
+;;
+;; ))
+;;
+;;
+;;(defun intern-atoms (display)
+;; (declare (type xlib:display display))
+;; (mapcar #'(lambda (atom-name) (xlib:intern-atom display atom-name))
+;; +exwm-atoms+)
+;; (values))
+;;
+;;
+;;
+;;(defun get-atoms-property (window property-atom atom-list-p)
+;; "Returns a list of atom-name (if atom-list-p is t) otherwise returns
+;; a list of atom-id."
+;; (xlib:get-property window property-atom
+;; :transform (when atom-list-p
+;; (lambda (id)
+;; (xlib:atom-name (xlib:drawable-display window) id)))))
+;;
+;;(defun set-atoms-property (window atoms property-atom &key (mode :replace))
+;; "Sets the property designates by `property-atom'. ATOMS is a list of atom-id
+;; or a list of keyword atom-names."
+;; (xlib:change-property window property-atom atoms :ATOM 32
+;; :mode mode
+;; :transform (unless (integerp (car atoms))
+;; (lambda (atom-key)
+;; (xlib:find-atom (xlib:drawable-display window) atom-key)))))
+;;
+;;
+;;
+;;
+;;(defun net-wm-state (window)
+;; (get-atoms-property window :_NET_WM_STATE t))
+;;
+;;(defsetf net-wm-state (window &key (mode :replace)) (states)
+;; `(set-atoms-property ,window ,states :_NET_WM_STATE :mode ,mode))
+;;
+;;
+;;
+;;(defun hide-window (window)
+;; (when window
+;; (with-xlib-protect
+;; (let ((net-wm-state (net-wm-state window)))
+;; (dbg net-wm-state)
+;; (pushnew :_net_wm_state_hidden net-wm-state)
+;; (setf (net-wm-state window) net-wm-state)
+;; (dbg (net-wm-state window)))
+;; (setf (window-state window) +iconic-state+
+;; (xlib:window-event-mask window) (remove :structure-notify *window-events*))
+;; (xlib:unmap-window window)
+;; (setf (xlib:window-event-mask window) *window-events*))))
(defun hide-window (window)
(when window
- (handler-case
- (progn
- (setf (window-state window) +iconic-state+
- (window-event-mask window) (remove :structure-notify *window-events*))
- (unmap-window window)
- (setf (window-event-mask window) *window-events*))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Hide window" window c)))))
+ (with-xlib-protect
+ (setf (window-state window) +iconic-state+
+ (xlib:window-event-mask window) (remove :structure-notify *window-events*))
+ (xlib:unmap-window window)
+ (setf (xlib:window-event-mask window) *window-events*))))
+
(defun window-type (window)
"Return one of :maxsize, :transient, or :normal."
- (or (and (get-property window :WM_TRANSIENT_FOR)
+ (or (and (xlib:get-property window :WM_TRANSIENT_FOR)
:transient)
- (and (let ((hints (wm-normal-hints window)))
- (and hints (or (wm-size-hints-max-width hints)
- (wm-size-hints-max-height hints))))
+ (and (let ((hints (xlib:wm-normal-hints window)))
+ (and hints (or (xlib:wm-size-hints-max-width hints)
+ (xlib:wm-size-hints-max-height hints))))
:maxsize)
:normal))
@@ -127,27 +270,27 @@
(defun send-configuration-notify (window)
"Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
(multiple-value-bind (x y)
- (translate-coordinates window 0 0 (drawable-root window))
- (send-event window
- :configure-notify
- (make-event-mask :structure-notify)
- :event-window window :window window
- :x x :y y
- :override-redirect-p nil
- :border-width (drawable-border-width window)
- :width (drawable-width window)
- :height (drawable-height window)
- :propagate-p nil)))
+ (xlib:translate-coordinates window 0 0 (xlib:drawable-root window))
+ (xlib:send-event window
+ :configure-notify
+ (xlib:make-event-mask :structure-notify)
+ :event-window window :window window
+ :x x :y y
+ :override-redirect-p nil
+ :border-width (xlib:drawable-border-width window)
+ :width (xlib:drawable-width window)
+ :height (xlib:drawable-height window)
+ :propagate-p nil)))
(defun send-client-message (window type &rest data)
"Send a client message to a client's window."
- (send-event window
- :client-message nil
- :window window
- :type type
- :format 32
- :data data))
+ (xlib:send-event window
+ :client-message nil
+ :window window
+ :type type
+ :format 32
+ :data data))
@@ -156,26 +299,19 @@
(defun raise-window (window)
"Map the window if needed and bring it to the top of the stack. Does not affect focus."
(when window
- (handler-case
- (progn
- (when (window-hidden-p window)
- (unhide-window window))
- (setf (window-priority window) :top-if))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Raise error" c window)))))
-
+ (with-xlib-protect
+ (when (window-hidden-p window)
+ (unhide-window window))
+ (setf (xlib:window-priority window) :top-if))))
(defun focus-window (window)
"Give the window focus."
(when window
- (handler-case
- (progn
- (raise-window window)
- (set-input-focus *display* window :pointer-root))
- ((or match-error window-error drawable-error) (c)
- (declare (ignore c))))))
- ;;(dbg "Focus error" c window)))))
+ (with-xlib-protect
+ (raise-window window)
+ (xlib:set-input-focus *display* window :parent))))
+ ;;(xlib:set-input-focus *display* :pointer-root :pointer-root)) ;;PHIL
+
@@ -183,7 +319,7 @@
(defun no-focus ()
"don't focus any window but still read keyboard events."
- (set-input-focus *display* *no-focus-window* :pointer-root))
+ (xlib:set-input-focus *display* *no-focus-window* :pointer-root))
@@ -193,10 +329,10 @@
(pointer-grabbed nil))
(labels ((free-grab-pointer ()
(when cursor
- (free-cursor cursor)
+ (xlib:free-cursor cursor)
(setf cursor nil))
(when cursor-font
- (close-font cursor-font)
+ (xlib:close-font cursor-font)
(setf cursor-font nil))))
(defun xgrab-init-pointer ()
(setf pointer-grabbed nil))
@@ -204,27 +340,28 @@
(defun xgrab-pointer-p ()
pointer-grabbed)
- (defun xgrab-pointer (root cursor-char cursor-mask-char)
+ (defun xgrab-pointer (root cursor-char cursor-mask-char
+ &optional (pointer-mask '(:enter-window :pointer-motion
+ :button-press :button-release)) owner-p)
"Grab the pointer and set the pointer shape."
(free-grab-pointer)
(setf pointer-grabbed t)
- (let* ((white (make-color :red 1.0 :green 1.0 :blue 1.0))
- (black (make-color :red 0.0 :green 0.0 :blue 0.0)))
- (setf cursor-font (open-font *display* "cursor")
- cursor (create-glyph-cursor :source-font cursor-font
- :source-char cursor-char
- :mask-font cursor-font
- :mask-char cursor-mask-char
- :foreground black
- :background white))
- (grab-pointer root '(:enter-window :pointer-motion
- :button-press :button-release)
- :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
+ (let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
+ (black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)))
+ (setf cursor-font (xlib:open-font *display* "cursor")
+ cursor (xlib:create-glyph-cursor :source-font cursor-font
+ :source-char cursor-char
+ :mask-font cursor-font
+ :mask-char cursor-mask-char
+ :foreground black
+ :background white))
+ (xlib:grab-pointer root pointer-mask
+ :owner-p owner-p :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
(defun xungrab-pointer ()
"Remove the grab on the cursor and restore the cursor shape."
(setf pointer-grabbed nil)
- (ungrab-pointer *display*)
+ (xlib:ungrab-pointer *display*)
(free-grab-pointer))))
@@ -237,28 +374,49 @@
(defun xgrab-keyboard (root)
(setf keyboard-grabbed t)
- (grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
+ (xlib:grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
[121 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp 2008/02/24 20:53:40 NONE
+++ /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp 2008/02/24 20:53:40 1.1
[398 lines skipped]
More information about the clfswm-cvs
mailing list