>From d78da625b22677474ecc8e44626284152717fe83 Mon Sep 17 00:00:00 2001 From: Morgan Veyret Date: Sat, 9 Aug 2008 00:22:33 +0200 Subject: [PATCH] Added support for automatic group creation and/or restoration. This adds two keyword parameters to rules: * :create , when non-NIL the group matching the rule is created if it doesn't already exist. The group may be restored from a dump-file in *data-dir* if such a file exists. The dump filename may be specified as :create "dump-file", if not it defaults to group-name. Defaults to NIL. * :restore , for group restoration from a dump file even if the matching group already exists. The dump filename should be specified as :restore "dump-file". Defaults to NIL. --- primitives.lisp | 20 +++++++++++++---- sample-stumpwmrc.lisp | 11 ++++++--- window-placement.lisp | 54 +++++++++++++++++++++++++++++++++++------------- 3 files changed, 61 insertions(+), 24 deletions(-) diff --git a/primitives.lisp b/primitives.lisp index 758f2dd..ccd9e4c 100644 --- a/primitives.lisp +++ b/primitives.lisp @@ -926,12 +926,11 @@ will have no effect.") "List of rules governing window placement. Use define-frame-preference to add rules") - (defmacro define-frame-preference (target-group &rest frame-rules) "Create a rule that matches windows and automatically places them in a specified group and frame. Each frame rule is a lambda list: @example -\(frame-number raise lock &key class instance type role title) +\(frame-number raise lock &key create restore dump-name class instance type role title) @end example @table @var @@ -948,6 +947,14 @@ of the group and the window is sent to @var{target-group}. If @var{lock} and @var{raise} are both non-nil, then stumpwm will jump to the specified group and focus the matched window. address@hidden create +When non-NIL the group is created and eventually restored when the value of +create is a group dump filename in *DATA-DIR*. Defaults to NIL. + address@hidden restore +When non-NIL the group is restored even if it already exists. This arg should +be set to the dump filename to use for forced restore. Defaults to NIL + @item class The window's class must match @var{class}. @@ -966,9 +973,12 @@ The window's title must match @var{title}. (let ((x (gensym "X"))) `(dolist (,x ',frame-rules) ;; verify the correct structure - (destructuring-bind (frame-number raise lock &rest keys &key class instance type role title) ,x - (declare (ignore class instance type role title)) - (push (list* ,target-group frame-number raise lock keys) *window-placement-rules*))))) + (destructuring-bind (frame-number raise lock + &rest keys + &key create restore class instance type role title) ,x + (declare (ignore create restore class instance type role title)) + (push (list* ,target-group frame-number raise lock keys) + *window-placement-rules*))))) (defun clear-window-placement-rules () "Clear all window placement rules." diff --git a/sample-stumpwmrc.lisp b/sample-stumpwmrc.lisp index 26235e7..3105dd4 100644 --- a/sample-stumpwmrc.lisp +++ b/sample-stumpwmrc.lisp @@ -47,10 +47,10 @@ ;; Last rule to match takes precedence! ;; TIP: if the argument to :title or :role begins with an ellipsis, a substring ;; match is performed. -;; TIP: rules won't do anything if the target groups/frames don't exist! Save -;; your layout with "asfdump" and "asfrestore" will re-create everything for -;; you. - +;; TIP: if the :create flag is set then a missing group will be created and +;; restored from *data-dir*/create file. +;; TIP: if the :restore flag is set then group dump is restored even for an +;; existing group using *data-dir*/restore file. (define-frame-preference "Default" ;; frame raise lock (lock AND raise == jumpto) (0 t nil :class "Konqueror" :role "...konqueror-mainwindow") @@ -70,3 +70,6 @@ (0 t nil :class "XTerm") (1 nil t :class "aMule")) +(define-frame-preference "Emacs" + (1 t t :restore "emacs-editing-dump" :title "...xdvi") + (0 t t :create "emacs-dump" :class "Emacs")) \ No newline at end of file diff --git a/window-placement.lisp b/window-placement.lisp index cd62481..cbb1186 100644 --- a/window-placement.lisp +++ b/window-placement.lisp @@ -34,19 +34,21 @@ (if role (string-match (window-role window) role) t) (if title (string-match (window-title window) title) t) t)) + (defun window-matches-rule-p (w rule) "Returns T if window matches rule" - (destructuring-bind (group-name frame raise lock &rest props) rule - (declare (ignore frame raise)) + (destructuring-bind (group-name frame raise lock + &key create restore class instance type role title) rule + (declare (ignore frame raise create restore)) (if (or lock - ;; The group slot may not be set at this point if the - ;; window is new. (equal group-name (group-name (or (when (slot-boundp w 'group) (window-group w)) (current-group))))) - (apply 'window-matches-properties-p w props)))) - -;; TODO: add rules allowing matched windows to create their own groups/frames + (window-matches-properties-p w :class class + :instance instance + :type type + :role role + :title title)))) (defun rule-matching-window (window) (dolist (rule *window-placement-rules*) @@ -57,21 +59,43 @@ the window should be raised." (let ((match (rule-matching-window window))) (if match - (destructuring-bind (group-name frame raise lock &rest props) match - (declare (ignore lock props)) + (destructuring-bind (group-name frame raise lock + &key create restore class instance type role title) match + (declare (ignore lock class instance type role title)) (let ((group (find-group screen group-name))) - (if group - (values group (frame-by-number group frame) raise) - (progn - (message "^B^1*Error placing window, group \"^b~a^B\" does not exist." group-name) - (values))))) + (cond (group + (when (and restore (stringp restore)) + (let ((restore-file (data-dir-file restore))) + (if (probe-file restore-file) + (restore-group group + (read-dump-from-file restore-file)) + (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"." + group-name restore-file)))) + (values group (frame-by-number group frame) raise)) + (create + (let ((new-group (add-group (current-screen) group-name)) + (restore-file (if (stringp create) + (data-dir-file create) + (data-dir-file group-name)))) + (if (and new-group + (probe-file restore-file)) + (restore-group new-group + (read-dump-from-file restore-file)) + (when (stringp create) + (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"." + group-name restore-file))) + (values new-group (frame-by-number new-group frame) raise))) + (t (message "^B^1*Error placing window, group \"^b~a^B\" does not exist." group-name) + (values))))) (values)))) (defun sync-window-placement () "Re-arrange existing windows according to placement rules" (dolist (screen *screen-list*) (dolist (window (screen-windows screen)) - (multiple-value-bind (to-group frame raise) (get-window-placement screen window) + (multiple-value-bind (to-group frame raise) + (with-current-screen screen + (get-window-placement screen window)) (declare (ignore raise)) (when to-group (unless (eq (window-group window) to-group) -- 1.5.4.5