Seeing the latest increase in activity I send these proposed contrib
additions.
I haven't changed any of them since sending them as preview, and haven't
had any problems on single- or dual-head setup.
I guess this can be included in the current form; if there are some
new ideas for improving workflow support, they can be discussed and
implemented.
////
wse is "window selection expressions" - some helper-abbreviations and a macro
to easily iterate over
windows satisfying some solution. Probably needs some redesign. Works for now.
Frame tags: as frames are transient notions meaningful mostly inside a single
StumpWM session,
no effort is made to preserve them across StumpWM restarts (unlike window
tags). Trivial tagging
support, with some natural operations like "move window to frame tagged
something".
Frame-tag-groups: treat tags starting with TG/ specially. All adjacent frames
sharing the same TG/
tag are called tagged group. You can remove all splits inside tagged group, you
can pull some
set of windows (probably defined by tags) into tagged group, you can tag all
windows in the
window group with some more tags, you can jump to tagged group by its name (or
name regexp).
All that doesn't support significant layout changes - this can be handled by
current
group mechanism, probably. I have a few fixed frame layouts so I just define
them as
commands in my rc. We could also make a storage for layouts (identified by
tags, of course)
and just swap entire heads inside tile-group-frame-tree (or multiple heads if
the tag is used
for layouts for different tags). I don't know whether anyone wants it done,
though.
(defun frame-tagged-group (f)
(or
(loop for x in (frame-tags f) when (cl-ppcre:scan "^TG/.*$" x)
return x)
"DEFAULT"))
(defun in-frame-tg-p (w x)
(equalp (frame-tagged-group (window-frame w)) x))
(defun in-current-ftg-p (w)
(equalp (frame-tagged-group (window-frame w))
(frame-tagged-group (tile-group-current-frame (current-group)))))
(defcommand
frame-group-push-pull-tags (argtags) ((:rest "Tags: "))
"Move away all windows from current frame group not with tags in argtags
and pull into current frame all windows with tags amongs argtags placed
in other frame groups or in other groups"
(let*
((tag (if (stringp argtags)
(remove "" (cl-ppcre:split " " (string-upcase argtags))
:test 'equalp)
(mapcar 'string-upcase argtags)))
(ftg (frame-tagged-group (tile-group-current-frame (current-group)))))
(fclear)
(act-on-matching-windows
(w :group) (and (in-frame-tg-p w ftg)
(not (tagged-any-p w tag)))
(push-w w))
(act-on-matching-windows
(w :screen) (and
(not (in-current-group-p w))
(tagged-any-p w tag))
(pull-w w))
(act-on-matching-windows
(w :screen) (and
(not (in-frame-tg-p w ftg))
(tagged-any-p w tag))
(pull-window w))))
(defcommand
ftg-set-tags (Argtags) ((:rest "Tags: "))
"My default tag-chooser"
(when
(equal (group-name (current-group)) ".tag-store")
(gselect (find-group (current-screen) "Default")))
(frame-group-push-pull-tags argtags)
(number-by-tags))
(defcommand
ftg-next-window () ()
"Switch to next window in frame group"
(focus-forward
(current-group)
(sort
(act-on-matching-windows
(w :group)
(in-frame-tg-p w (frame-tagged-group
(tile-group-current-frame (current-group))))
w)
'< :key 'window-number)
nil))
(defcommand
(set-frame-group tile-group) (name) ((:rest "Name: "))
"Set tagged-group of current frame"
(unless (cl-ppcre:scan " " name)
(setf (frame-tags (tile-group-current-frame (current-group)))
(cons
(format nil "TG/~a" (string-upcase name))
(remove-if
(lambda (s) (cl-ppcre:scan "^TG/" s))
(frame-tags (tile-group-current-frame (current-group))))))))
(defun eat-frame (group eater food)
(dformat 7 "~%Eat frame? ~s:~%~s ~s~%@~%~s ~s~%"
group eater food (frame-head group eater) (frame-head group food))
(when
(equal (frame-head group eater) (frame-head group food))
(dformat 9 "Frame tree was: ~s~%"
(tile-group-frame-tree group))
(if (= (frame-y eater) (frame-y food))
(progn
(setf (frame-width eater) (+ (frame-width eater) (frame-width food)))
(when (> (frame-x eater) (frame-x food))
(setf (frame-x eater) (frame-x food)
(frame-x food) (1+ (frame-x food))))
(setf (frame-width food) 0))
(progn
(setf (frame-height eater)
(+ (frame-height eater) (frame-height food)))
(when (> (frame-y eater) (frame-y food))
(setf (frame-y eater) (frame-y food)
(frame-y food) (1+ (frame-y food))))
(setf (frame-height food) 0)))
(dformat 9 "Frame tree is: ~s~%"
(tile-group-frame-tree group))
(remove-split group food)))
(defun every-in-tree (p tr)
(cond
((null tr) t)
((atom tr) (funcall p tr))
(t (not (find-if (lambda (x) (not (every-in-tree p x))) tr)))))
(defun eat-ftg-siblings (&key (group (current-group))
(frame (tile-group-current-frame group)))
(let*
((tr (tile-group-frame-tree group))
(ftg (frame-tagged-group frame))
(s tr)
(d 0)
(n (position frame s))
(l (length s)))
(loop while (not n)
do (progn
(setf s (next-sibling s frame))
(setf n (position frame s))
(setf l (length s))
(incf d)))
(if (= d 0) nil
(< 0
(+
(if (> n 0)
(let*
((food (nth (1- n) s)))
(if
(every-in-tree
(lambda (x) (equalp (frame-tagged-group x) ftg))
food)
(progn
(if (listp food)
(progn
(focus-frame group (tree-leaf food))
(ftg-only))
(eat-frame group frame food))
1)
0))
0)
(if (< n (1- l))
(let*
((eater (nth (1+ n) s)))
(if
(every-in-tree
(lambda (x) (equalp (frame-tagged-group x) ftg))
eater)
(progn
(if (listp eater)
(progn
(focus-frame group (tree-leaf eater))
(ftg-only))
(eat-frame group eater frame))
1)
0))
0))))))
(defcommand ftg-only () ()
(loop while (eat-ftg-siblings)))
(defcommand
ftg-mark-windows (argtags) ((:rest "Tags: "))
"Mark all windows in the frames of current tagged group with argtags"
(act-on-matching-windows
(w :group)
(in-frame-tg-p w (frame-tagged-group
(tile-group-current-frame (current-group))))
(tag-window argtags w)))
(defcommand
ftg-set-tag-re (re &optional keep-old) ((:rest "Tag pattern: "))
"In current ftg there will be all windows with tags matching re"
(fclear)
(setf re (string-upcase re))
(unless keep-old
(act-on-matching-windows
(w :group)
(and
(in-current-ftg-p w)
(not (find-if (lambda (x) (cl-ppcre:scan re x)) (window-tags w))))
(push-w w)))
(act-on-matching-windows
(w :screen)
(and
(not
(and
(in-current-ftg-p w)
(in-current-group-p w)))
(find-if (lambda (x) (cl-ppcre:scan re x)) (window-tags w)))
(pull-w w))
(act-on-matching-windows
(w :group)
(and
(not (in-current-ftg-p w))
(find-if (lambda (x) (cl-ppcre:scan re x)) (window-tags w)))
(pull-window w)))
(defcommand
ftg-add-tag-re (re) ((:rest "Tag pattern: "))
"Add all windows with tags matching re to current ftg"
(ftg-set-tag-re re t))
(defun frame-split-tagging-hook (p f1 f2)
(setf (frame-tags f1) (frame-tags p))
(setf (frame-tags f2) (frame-tags p)))
;; Copyright 2011 Michael Raskin
;;
;; Maintainer: Michael Raskin
;;
;; This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;; Frame tagging
(in-package :stumpwm)
(defvar *frame-tags* (make-hash-table))
(defcommand frame-tags (&optional (argframe nil)) ()
"Show frame tags"
(let* ((frame (or argframe (tile-group-current-frame
(current-group))))
(tags (gethash frame *frame-tags*)))
(if argframe tags (message "Tags: ~{~%~a~}" tags))))
(defun (setf frame-tags)
(argtags &optional (frame (tile-group-current-frame
(current-group))))
"Set frame tags"
(let*
((tags (if (stringp argtags)
(remove "" (cl-ppcre:split " " (string-upcase argtags))
:test 'equalp)
(mapcar 'string-upcase argtags))))
(setf (gethash frame *frame-tags*) tags)))
(defun remove-frame-tags
(argtags &optional (frame (tile-group-current-frame
(current-group))))
(let*
((tags (if (stringp argtags)
(remove "" (cl-ppcre:split " " (string-upcase argtags)) :test
'equal)
(mapcar 'string-upcase argtags))))
(setf (frame-tags frame)
(remove-if (lambda (x) (find x tags :test 'equalp))
(frame-tags frame)))))
(defcommand
tag-frame (argtags &optional (frame (tile-group-current-frame
(current-group))))
((:rest "Tag to set: ") :rest)
"Add a tag to current frame"
(let*
((tags
(if (stringp argtags)
(remove "" (cl-ppcre:split " " (string-upcase argtags)) :test 'equal)
(mapcar 'string-upcase argtags))))
(setf (frame-tags frame) (union tags (frame-tags frame) :test 'equalp))))
(defcommand
clear-all-frame-tags (&optional (frame (tile-group-current-frame
(current-group)))) ()
(setf (frame-tags frame) nil))
(defun first-frame-by-tag (tag &optional (group (current-group)))
(loop for x in (group-frames group)
when (find (string-upcase tag) (frame-tags x) :test 'equal)
return x))
(defun first-frame-by-tag-re (tag &optional (group (current-group)))
(loop for x in (group-frames group)
when (find (string-upcase tag) (frame-tags x) :test
(lambda (x y) (cl-ppcre:Scan x y)))
return x))
(defcommand focus-frame-by-tag (tag) ((:rest "Tag: "))
(let*
((frame (first-frame-by-tag tag)))
(when frame (focus-frame (current-group) frame))))
(defcommand focus-frame-by-tag-re (tag) ((:rest "Tag: "))
(let*
((frame (first-frame-by-tag-re tag)))
(when frame (focus-frame (current-group) frame))))
(in-package :stumpwm)
(defun in-frame-tagged-p (w name)
(find name (frame-tags (window-frame w)) :test 'equalp))
(defun to-tagged-frame (w name)
(let*
((frame (find-if (lambda (x) (find name (frame-tags x) :Test 'equalp))
(group-frames (current-group (current-screen))))))
(when frame (pull-window w frame))))
(in-package :stumpwm)
(defun push-w (w) (move-windows-to-group (list w) ".tag-store"))
(defun tagged-p (w tag)
(or (equal tag "T") (find tag (window-tags w) :test 'equalp)))
(defun tagged-any-p (w argtags)
(let*
((tag (if (stringp argtags)
(remove "" (cl-ppcre:split " " (string-upcase argtags))
:test 'equalp)
(mapcar 'string-upcase argtags))))
(intersection tag (cons "T" (window-tags w)) :test 'equalp)))
(defun tag-re-p (w tre)
(find-if (lambda (tag) (cl-ppcre:scan tre tag)) (cons "T" (window-tags w))))
;; Copyright 2011 Michael Raskin
;;
;; Maintainer: Michael Raskin
;;
;; This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;; Window Selection Expressions
(in-package :stumpwm)
(defmacro act-on-matching-windows
((var &optional (range '(current-screen))) condition &rest code)
"Run code on all windows matching condition; var is the shared lambda
variable"
`(let
((range ,range))
(loop for ,var in
(cond
((typep range 'screen) (screen-windows range))
((typep range 'group) (group-windows range))
((typep range 'frame) (frame-windows (current-group) range))
((typep range 'list) range)
((eq range :screen) (screen-windows (current-screen)))
((eq range :group)
(group-windows (current-group)))
((eq range :frame)
(frame-windows (current-group)
(tile-group-current-frame
(current-group))))
(t (error "Unknown kind of window set")))
when ,condition
collect (progn ,@code))))
(defun pull-w (w) (move-windows-to-group (list w) (current-group)))
(defun titled-p (w title) (equal (window-title w) title))
(defun title-re-p (w tre) (cl-ppcre:Scan tre (window-title w)))
(defun classed-p (w class) (equal (window-class w) class))
(defun class-re-p (w cre) (cl-ppcre:Scan cre (window-class w)))
(defun typed-p (w type) (equal (window-type w) type))
(defun type-re-p (w tre) (cl-ppcre:Scan tre (window-type w)))
(defun roled-p (w role) (equal (window-role w) role))
(defun role-re-p (w rre) (cl-ppcre:Scan rre (window-role w)))
(defun resed-p (w res) (equal (window-res w) res))
(defun res-re-p (w rre) (cl-ppcre:Scan rre (window-res w)))
(defun classed-p (w class) (equal (window-class w) class))
(defun class-re-p (w cre) (cl-ppcre:Scan cre (window-class w)))
(defun grouped-p (w name) (equal name (group-name (window-group w))))
(defun in-current-group-p (w) (equal (window-group w) (current-group)))
(defun in-frame-p (w f) (eq (window-frame w) f))
(defun in-current-frame-p (w)
(equal (window-frame w) (tile-group-current-frame
(current-group (current-screen)))))
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
https://lists.nongnu.org/mailman/listinfo/stumpwm-devel
