[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Tue Feb 26 22:02:04 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv1178
Modified Files:
ChangeLog bindings-second-mode.lisp clfswm-internal.lisp
clfswm-util.lisp clfswm.lisp load.lisp package.lisp tools.lisp
Log Message:
focus/copy/move/delete by name or number
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2008/02/24 20:53:37 1.15
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2008/02/26 22:02:02 1.16
@@ -1,3 +1,11 @@
+2008-02-26 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-util.lisp (copy/cut-current-child): Does not affect the
+ root group.
+ (copy/move-current-child-by-name/number): new functions
+ (focus-group-by-name/number): new functions
+ (delete-group-by-name/number): new functions
+
2008-02-24 Philippe Brochard <hocwp at free.fr>
* *: Major update - No more reference to workspaces. The main
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/24 20:53:37 1.12
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/26 22:02:02 1.13
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Feb 24 21:34:42 2008
+;;; #Date#: Tue Feb 26 22:41:08 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -80,15 +80,34 @@
+
+
+
+
+(defun action-by-name-menu ()
+ "Actions by name menu"
+ (info-mode-menu '((#\f focus-group-by-name)
+ (#\d delete-group-by-name)
+ (#\m move-current-child-by-name)
+ (#\c copy-current-child-by-name))))
+
+(defun action-by-number-menu ()
+ "Actions by number menu"
+ (info-mode-menu '((#\f focus-group-by-number)
+ (#\d delete-group-by-number)
+ (#\m move-current-child-by-number)
+ (#\c copy-current-child-by-number))))
+
+
(defun group-menu ()
- "Open the group menu"
+ "Group menu"
(info-mode-menu '((#\a group-adding-menu)
(#\l group-layout-menu)
(#\m group-movement-menu))))
(defun utility-menu ()
- "Open the utility menu"
+ "Utility menu"
(info-mode-menu '((#\i identify-key)
(#\: eval-from-query-string)
(#\! run-program-from-query-string))))
@@ -98,7 +117,9 @@
(info-mode-menu '((#\g group-menu)
(#\w window-menu)
(#\s selection-menu)
- (#\u utility-menu))))
+ (#\n action-by-name-menu)
+ (#\u action-by-number-menu)
+ (#\y utility-menu))))
@@ -109,6 +130,8 @@
(define-second-key ("m") 'main-menu)
(define-second-key ("g") 'group-menu)
+(define-second-key ("n") 'action-by-name-menu)
+(define-second-key ("u") 'action-by-number-menu)
;;(define-second-key (#\g :control) 'stop-all-pending-actions)
@@ -160,6 +183,7 @@
;;; Selection
(define-second-key ("x" :control) 'cut-current-child)
+(define-second-key ("x" :control :mod-1) 'clear-selection)
(define-second-key ("c" :control) 'copy-current-child)
(define-second-key ("v" :control) 'paste-selection)
(define-second-key ("v" :control :shift) 'paste-selection-no-clear)
@@ -168,6 +192,7 @@
+
(defun sm-handle-click-to-focus (root-x root-y)
"Give the focus to the clicked child"
(let ((win (find-child-under-mouse root-x root-y)))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/24 20:53:37 1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/26 22:02:02 1.15
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Feb 24 21:38:37 2008
+;;; #Date#: Tue Feb 26 22:49:18 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -63,27 +63,18 @@
(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)))
+(defgeneric child-name (child))
+
+(defmethod child-name ((child xlib:window))
+ (xlib:wm-name child))
+
+(defmethod child-name ((child group))
+ (group-name child))
+
+(defmethod child-name (child)
+ "???")
@@ -139,6 +130,50 @@
+(defun group-find-free-number ()
+ (let ((all-numbers nil))
+ (with-all-groups (*root-group* group)
+ (push (group-number group) all-numbers))
+ (find-free-number all-numbers)))
+
+
+
+(defun create-group (&key name (number (group-find-free-number)) (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 :number number
+ :x x :y y :w w :h h :window window :gc gc :layout layout)))
+
+
+(defun add-group (group father)
+ (push group (group-child father)))
+
+
+
+
+
+
+(defun get-current-child ()
+ "Return the current focused child"
+ (unless (equal *current-child* *root-group*)
+ (typecase *current-child*
+ (xlib:window *current-child*)
+ (group (if (xlib:window-p (first (group-child *current-child*)))
+ (first (group-child *current-child*))
+ *current-child*)))))
(defun find-child (to-find root)
@@ -164,6 +199,22 @@
(return-from find-group-window group))))
+(defun find-group-by-name (name)
+ "Find a group from its name"
+ (when name
+ (with-all-groups (*root-group* group)
+ (when (string-equal name (group-name group))
+ (return-from find-group-by-name group)))))
+
+(defun find-group-by-number (number)
+ "Find a group from its number"
+ (when (numberp number)
+ (with-all-groups (*root-group* group)
+ (when (= number (group-number group))
+ (return-from find-group-by-number group)))))
+
+
+
(defun get-all-windows (&optional (root *root-group*))
"Return all windows in root and in its childs"
@@ -183,9 +234,6 @@
-
-
-
(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
@@ -476,12 +524,18 @@
(setf *current-child* father)
t)))
+(defun set-current-root (father)
+ "Set current root if father is not in current root"
+ (unless (find-child father *current-root*)
+ (setf *current-root* father)))
+
(defun focus-all-child (child father)
"Focus child and its fathers - Set current group to father"
(let ((new-focus (focus-child-rec child father))
- (new-current-child (set-current-child child father)))
- (or new-focus new-current-child)))
+ (new-current-child (set-current-child child father))
+ (new-root (set-current-root father)))
+ (or new-focus new-current-child new-root)))
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/24 20:53:37 1.11
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/26 22:02:02 1.12
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Feb 22 22:44:09 2008
+;;; #Date#: Tue Feb 26 22:57:45 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -32,8 +32,10 @@
(defun add-default-group ()
"Add a default group"
(when (group-p *current-child*)
- (push (create-group) (group-child *current-child*))
- (show-all-childs)))
+ (let ((name (query-string "Group name")))
+ (push (create-group :name name) (group-child *current-child*))))
+ (leave-second-mode))
+
(defun add-placed-group ()
"Add a placed group"
@@ -44,8 +46,8 @@
(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)))
+ (group-child *current-child*))))
+ (leave-second-mode))
@@ -108,36 +110,37 @@
;;; Selection functions
-(defun get-current-child ()
- "Return the current focused child"
- (typecase *current-child*
- (xlib:window *current-child*)
- (group (if (xlib:window-p (first (group-child *current-child*)))
- (first (group-child *current-child*))
- *current-child*))))
+(defun clear-selection ()
+ "Clear the current selection"
+ (setf *child-selection* nil)
+ (display-group-info *current-root*))
(defun copy-current-child ()
"Copy the current child to the selection"
(let ((child (get-current-child)))
- (pushnew child *child-selection*)
- (display-group-info *current-root*)
- child))
+ (when child
+ (pushnew child *child-selection*)
+ (display-group-info *current-root*)
+ child)))
(defun cut-current-child ()
"Cut the current child to the selection"
(let ((child (copy-current-child)))
- (setf *current-child* *current-root*)
- (hide-child child)
- (remove-child-in-group child (find-father-group child *current-root*))
- (show-all-childs)))
+ (when child
+ (setf *current-child* *current-root*)
+ (hide-child child)
+ (remove-child-in-group child (find-father-group child *current-root*))
+ (show-all-childs))))
(defun remove-current-child ()
"Remove the current child from its father group"
(let ((child (get-current-child)))
- (setf *current-child* *current-root*)
- (hide-child child)
- (remove-child-in-group child (find-father-group child *current-root*))
- (show-all-childs)))
+ (when child
+ (setf *current-child* *current-root*)
+ (hide-child child)
+ (remove-child-in-group child (find-father-group child *current-root*))))
+ (leave-second-mode))
+
(defun paste-selection-no-clear ()
"Paste the selection in the current group - Do not clear the selection after paste"
@@ -149,11 +152,386 @@
(pushnew child (group-child group-dest)))
(show-all-childs))))
-(defun paste-selection ()
- "Paste the selection in the current group"
- (paste-selection-no-clear)
- (setf *child-selection* nil)
- (display-group-info *current-root*))
+(defun paste-selection ()
+ "Paste the selection in the current group"
+ (paste-selection-no-clear)
+ (setf *child-selection* nil)
+ (display-group-info *current-root*))
+
+
+
+
+
+
+
+;;; CONFIG - Identify mode
+(defun identify-key ()
+ "Identify a key"
+ (let* ((done nil)
+ (font (xlib:open-font *display* *identify-font-string*))
+ (window (xlib:create-window :parent *root*
+ :x 0 :y 0
+ :width (- (xlib:screen-width *screen*) 2)
+ :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+ :background (get-color *identify-background*)
+ :border-width 1
+ :border (get-color *identify-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *identify-foreground*)
+ :background (get-color *identify-background*)
+ :font font
+ :line-style :solid)))
+ (labels ((print-key (code keysym key modifiers)
+ (xlib:clear-area window)
+ (setf (xlib:gcontext-foreground gc) (get-color *identify-foreground*))
+ (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5)
+ (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
+ (when code
+ (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (format nil "Code=~A KeySym=~A Key=~S Modifiers=~A"
+ code keysym key modifiers))))
+ (handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (let* ((modifiers (xlib:make-state-keys state))
+ (key (keycode->char code state))
+ (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+ (setf done (and (equal key #\q) (null modifiers)))
+ (dbg code keysym key modifiers)
+ (print-key code keysym key modifiers)
+ (force-output)))
+ (handle-identify (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-identify-key event-slots) t)
+ (:exposure (print-key nil nil nil nil)))
+ t))
+ (xgrab-pointer *root* 92 93)
+ (xlib:map-window window)
+ (format t "~&Press 'q' to stop the identify loop~%")
+ (print-key nil nil nil nil)
+ (force-output)
+ (unwind-protect
+ (loop until done do
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-identify))
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (xgrab-pointer *root* 66 67)))))
+
+
+
+(defun query-show-paren (orig-string pos)
+ "Replace matching parentheses with brackets"
+ (let ((string (copy-seq orig-string)))
+ (labels ((have-to-find-right? ()
+ (and (< pos (length string)) (char= (aref string pos) #\()))
+ (have-to-find-left? ()
+ (and (> (1- pos) 0) (char= (aref string (1- pos)) #\))))
+ (pos-right ()
+ (loop :for p :from (1+ pos) :below (length string)
+ :with level = 1 :for c = (aref string p)
+ :do (when (char= c #\() (incf level))
+ (when (char= c #\)) (decf level))
+ (when (= level 0) (return p))))
+ (pos-left ()
+ (loop :for p :from (- pos 2) :downto 0
+ :with level = 1 :for c = (aref string p)
+ :do (when (char= c #\() (decf level))
+ (when (char= c #\)) (incf level))
+ (when (= level 0) (return p)))))
+ (when (have-to-find-right?)
+ (let ((p (pos-right)))
+ (when p (setf (aref string p) #\]))))
+ (when (have-to-find-left?)
+ (let ((p (pos-left)))
+ (when p (setf (aref string p) #\[))))
+ string)))
+
+
+;;; CONFIG - Query string mode
+(let ((history nil))
+ (defun clear-history ()
+ "Clear the query-string history"
+ (setf history nil))
+
+ (defun query-string (msg &optional (default ""))
+ "Query a string from the keyboard. Display msg as prompt"
+ (let* ((done nil)
+ (font (xlib:open-font *display* *query-font-string*))
+ (window (xlib:create-window :parent *root*
+ :x 0 :y 0
+ :width (- (xlib:screen-width *screen*) 2)
+ :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+ :background (get-color *query-background*)
+ :border-width 1
+ :border (get-color *query-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *query-foreground*)
+ :background (get-color *query-background*)
+ :font font
+ :line-style :solid))
+ (result-string default)
+ (pos (length default))
+ (local-history history))
+ (labels ((add-cursor (string)
+ (concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
+ (print-string ()
+ (xlib:clear-area window)
+ (setf (xlib:gcontext-foreground gc) (get-color *query-foreground*))
+ (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5) msg)
+ (when (< pos 0) (setf pos 0))
+ (when (> pos (length result-string)) (setf pos (length result-string)))
+ (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (add-cursor (query-show-paren result-string pos))))
+ (call-backspace (modifiers)
+ (let ((del-pos (if (member :control modifiers)
+ (or (position #\Space result-string :from-end t :end pos) 0)
+ (1- pos))))
+ (when (>= del-pos 0)
+ (setf result-string (concatenate 'string
+ (subseq result-string 0 del-pos)
+ (subseq result-string pos))
+ pos del-pos))))
+ (call-delete (modifiers)
+ (let ((del-pos (if (member :control modifiers)
+ (1+ (or (position #\Space result-string :start pos) (1- (length result-string))))
+ (1+ pos))))
+ (if (<= del-pos (length result-string))
+ (setf result-string (concatenate 'string
+ (subseq result-string 0 pos)
+ (subseq result-string del-pos))))))
+ (call-delete-eof ()
+ (setf result-string (subseq result-string 0 pos)))
+ (handle-query-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (let* ((modifiers (xlib:make-state-keys state))
+ (keysym (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
+ ((member :mod-5 modifiers) 2)
+ (t 0))))
+ (char (xlib:keysym->character *display* keysym))
+ (keysym-name (keysym->keysym-name keysym)))
+ (setf done (cond ((string-equal keysym-name "Return") :Return)
+ ((string-equal keysym-name "Tab") :Complet)
+ ((string-equal keysym-name "Escape") :Escape)
+ (t nil)))
+ (cond ((string-equal keysym-name "Left")
+ (when (> pos 0)
+ (setf pos (if (member :control modifiers)
+ (let ((p (position #\Space result-string
+ :end (min (1- pos) (length result-string))
+ :from-end t)))
+ (if p p 0))
+ (1- pos)))))
+ ((string-equal keysym-name "Right")
+ (when (< pos (length result-string))
+ (setf pos (if (member :control modifiers)
+ (let ((p (position #\Space result-string
+ :start (min (1+ pos) (length result-string)))))
+ (if p p (length result-string)))
+ (1+ pos)))))
+ ((string-equal keysym-name "Up")
+ (setf result-string (first local-history)
+ pos (length result-string)
+ local-history (rotate-list local-history)))
+ ((string-equal keysym-name "Down")
+ (setf result-string (first local-history)
+ pos (length result-string)
+ local-history (anti-rotate-list local-history)))
+ ((string-equal keysym-name "Home") (setf pos 0))
+ ((string-equal keysym-name "End") (setf pos (length result-string)))
+ ((string-equal keysym-name "Backspace") (call-backspace modifiers))
+ ((string-equal keysym-name "Delete") (call-delete modifiers))
+ ((and (string-equal keysym-name "k") (member :control modifiers))
+ (call-delete-eof))
+ ((and (characterp char) (standard-char-p char))
+ (setf result-string (concatenate 'string
+ (when (<= pos (length result-string))
+ (subseq result-string 0 pos))
+ (string char)
+ (when (< pos (length result-string))
+ (subseq result-string pos))))
+ (incf pos)))
+ (print-string)))
+ (handle-query (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-query-key event-slots) t)
+ (:exposure (print-string)))
+ t))
+ (xgrab-pointer *root* 92 93)
+ (xlib:map-window window)
+ (print-string)
+ (wait-no-key-or-button-press)
+ (unwind-protect
+ (loop until (member done '(:Return :Escape :Complet)) do
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-query))
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (xgrab-pointer *root* 66 67)))
+ (values (when (member done '(:Return :Complet))
+ (push result-string history)
+ result-string)
+ done))))
+
+
+
+(defun query-number (msg)
+ "Query a number from the query input"
+ (parse-integer (or (query-string msg) "") :junk-allowed t))
+
+
+
+(defun eval-from-query-string ()
+ "Eval a lisp form from the query input"
+ (let ((form (query-string "Eval:"))
+ (result nil))
+ (when (and form (not (equal form "")))
+ (let ((printed-result
+ (with-output-to-string (*standard-output*)
+ (setf result (handler-case
+ (loop for i in (multiple-value-list
+ (eval (read-from-string form)))
+ collect (format nil "~S" i))
+ (error (condition)
+ (format nil "~A" condition)))))))
+ (info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
+ (ensure-list printed-result)
+ (ensure-list result)))
+ :width (- (xlib:screen-width *screen*) 2))
+ (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))))
+
+
+
+
+;;; Group name actions
+;;;(loop :for str :in '("The Gimp" "The klm" "klm" "abc") ;; Test
+;;; :when (zerop (or (search "ThE" str :test #'string-equal) -1))
+;;; :collect str)
+(defun ask-group-name (msg)
+ "Ask a group name"
+ (let ((all-group-name nil)
+ (name ""))
+ (with-all-groups (*root-group* group)
+ (awhen (group-name group) (push it all-group-name)))
+ (labels ((selected-names ()
+ (loop :for str :in all-group-name
+ :when (zerop (or (search name str :test #'string-equal) -1))
+ :collect str))
+ (complet-alone (req sel)
+ (if (= 1 (length sel)) (first sel) req))
+ (ask ()
+ (let* ((selected (selected-names))
+ (default (complet-alone name selected)))
+ (multiple-value-bind (str done)
+ (query-string (format nil "~A: ~{~A~^, ~}" msg selected) default)
+ (setf name str)
+ (when (or (not (string-equal name default)) (eql done :complet))
+ (ask))))))
+ (ask))
+ name))
+
+
+
+;;; Focus by functions
+(defun focus-group-by (group)
+ (when (group-p group)
+ (focus-all-child group (or (find-father-group group *current-root*)
+ (find-father-group group)))))
[341 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/24 20:53:37 1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/26 22:02:02 1.14
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Feb 24 21:36:00 2008
+;;; #Date#: Tue Feb 26 22:03:18 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -225,24 +225,11 @@
;;(intern-atoms *display*)
(netwm-set-properties)
(xlib:display-force-output *display*)
- (setf *child-selection* nil
- *current-group-number* -1)
- (setf *root-group* (create-group :name "Root" :layout #'tile-space-layout)
+ (setf *child-selection* nil)
+ (setf *root-group* (create-group :name "Root" :number 0 :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*)
(show-all-childs)
(grab-main-keys)
@@ -267,7 +254,9 @@
(error (c)
(format t "~2%*** Error loading configurtion file: ~A ***~&~A~%" conf c)
(values nil (format nil "~s" c) conf))
- (:no-error (&rest args) (declare (ignore args)) (values t nil conf)))
+ (:no-error (&rest args)
+ (declare (ignore args))
+ (values t nil conf)))
(values t nil nil))))
@@ -280,9 +269,17 @@
(format t "~&~A~&Maybe another window manager is running.~%" c)
(force-output)
(return-from main 'init-display-error)))
+ (handler-case
+ (init-display)
+ (xlib:access-error (c)
+ (ungrab-main-keys)
+ (xlib:destroy-window *no-focus-window*)
+ (xlib:close-display *display*)
+ (format t "~&~A~&Maybe another window manager is running.~%" c)
+ (force-output)
+ (return-from main 'init-display-error)))
(unwind-protect
(catch 'exit-main-loop
- (init-display)
(main-loop))
(ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
--- /project/clfswm/cvsroot/clfswm/load.lisp 2008/02/25 20:11:08 1.6
+++ /project/clfswm/cvsroot/clfswm/load.lisp 2008/02/26 22:02:02 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Mon Feb 25 21:08:57 2008
+;;; #Date#: Tue Feb 26 21:45:34 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: System loading functions
@@ -56,4 +56,4 @@
(in-package :clfswm)
-(clfswm:main ":0")
+(clfswm:main ":1")
--- /project/clfswm/cvsroot/clfswm/package.lisp 2008/02/24 20:53:37 1.10
+++ /project/clfswm/cvsroot/clfswm/package.lisp 2008/02/26 22:02:02 1.11
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Feb 24 21:35:31 2008
+;;; #Date#: Mon Feb 25 21:33:22 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Package definition
@@ -48,8 +48,6 @@
(defparameter *child-selection* nil)
-(defparameter *current-group-number* -1)
-
(defparameter *layout-list* nil)
@@ -59,9 +57,8 @@
(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
+ (number :initarg :number :accessor group-number :initform 0)
+ ;;; Float size between 0 and 1 - 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)
--- /project/clfswm/cvsroot/clfswm/tools.lisp 2008/02/24 20:53:37 1.6
+++ /project/clfswm/cvsroot/clfswm/tools.lisp 2008/02/26 22:02:02 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 12 14:03:59 2008
+;;; #Date#: Tue Feb 26 21:53:55 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: General tools
More information about the clfswm-cvs
mailing list