x11-wm/stumpwm.stumpwm
1
0
Fork 0
mirror of https://github.com/stumpwm/stumpwm.git synced 2026-09-10 07:26:20 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

Replaced all tab characters with an appropriate number of spaces.

Browse source
This commit is contained in:
Grayson Croom 2017-12-20 14:32:38 -06:00
parent 2d285802fe
commit 00a0fa008a
17 changed files with 196 additions and 183 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
AUTHORS
View file

@ -62,4 +62,5 @@ Yu Changyuan reivzy at gmail com
Edward Trumbo trumboe at comcast net
Javier Olaechea pirata at gmail com
Caio Oliveira caioaao at gmail com
Thomas Atkinson thomas at pinegrove io
Thomas Atkinson thomas at pinegrove io
Grayson Croom grayson at gmail com

41
command.lisp
View file

@ -292,7 +292,7 @@ only return active commands."
(throw 'error :abort)))
(defmacro define-stumpwm-type (type (input prompt) &body body)
"Create a new type that can be used for command arguments. @var{type} can be any symbol.
"Create a new type that can be used for command arguments. @var{type} can be any symbol.
When @var{body} is evaluated @var{input} is bound to the
argument-line. It is passed to @code{argument-pop},
@ -301,25 +301,26 @@ be used when prompting the user for the argument.
@example
\(define-stumpwm-type :symbol (input prompt)
(or (find-symbol (string-upcase
(or (argument-pop input)
;; Whitespace messes up find-symbol.
(string-trim \" \"
(completing-read (current-screen)
prompt
;; find all symbols in the
;; stumpwm package.
(let (acc)
(do-symbols (s (find-package \"STUMPWM\"))
(push (string-downcase (symbol-name s)) acc))
acc)))
(throw 'error \"Abort.\")))
\"STUMPWM\")
(or (find-symbol
(string-upcase
(or (argument-pop input)
;; Whitespace messes up find-symbol.
(string-trim \" \"
(completing-read (current-screen)
prompt
;; find all symbols in the
;; stumpwm package.
(let (acc)
(do-symbols (s (find-package \"STUMPWM\"))
(push (string-downcase (symbol-name s)) acc))
acc)))
(throw 'error \"Abort.\")))
\"STUMPWM\")
(throw 'error \"Symbol not in STUMPWM package\")))
\(defcommand \"symbol\" (sym) ((:symbol \"Pick a symbol: \"))
(message \"~a\" (with-output-to-string (s)
(describe sym s))))
(describe sym s))))
@end example
This code creates a new type called @code{:symbol} which finds the
@ -540,16 +541,16 @@ user aborted."
:start 0))
(cmd (argument-pop arg-line)))
(let ((*interactivep* interactivep))
(call-interactively cmd arg-line)))))
(call-interactively cmd arg-line)))))
(multiple-value-bind (result error-p)
;; this fancy footwork lets us grab the backtrace from where the
;; error actually happened.
(restart-case
(handler-bind
(handler-bind
((error (lambda (c)
(invoke-restart 'eval-command-error
(format nil "^B^1*Error In Command '^b~a^B': ^n~A~a"
cmd c (if *show-command-backtrace*
(format nil "^B^1*Error In Command '^b~a^B': ^n~A~a"
cmd c (if *show-command-backtrace*
(backtrace-string) ""))))))
(parse-and-run-command cmd))
(eval-command-error (err-text)

29
input.lisp
View file

@ -26,16 +26,16 @@
(export '(*input-history-ignore-duplicates*
*input-map*
*numpad-map*
completing-read
input-delete-region
input-goto-char
input-insert-char
input-insert-string
input-point
input-substring
input-validate-region
read-one-char
read-one-line))
completing-read
input-delete-region
input-goto-char
input-insert-char
input-insert-string
input-point
input-substring
input-validate-region
read-one-char
read-one-line))
(defstruct input-line
string position history history-bk password)
@ -94,7 +94,7 @@
"Do not add a command to the input history if it's already the first in the list.")
(defvar *numpad-map* '((87 10 . 16) (88 11 . 16) (89 12 . 16) (106 61 . 16)
(83 13 . 16) (84 14 . 16) (85 15 . 16) (86 21 . 17)
(79 16 . 16) (80 17 . 16) (81 18 . 16) (63 17 . 17)
(79 16 . 16) (80 17 . 16) (81 18 . 16) (63 17 . 17)
(82 20 . 16) (104 36 . 16) (91 60 . 16) (90 19 . 16))
"A keycode to keycode map to re-wire numpads when the numlock key is active")
@ -125,15 +125,14 @@
;; Draw the prompt
(draw-input-bucket screen prompt input)
;; Ready to recieve input
))
(defun shutdown-input-window (screen)
(xlib:ungrab-keyboard *display*)
(xlib:unmap-window (screen-input-window screen)))
;; Hack to avoid clobbering input from numpads with numlock on.
(defun input-handle-key-press-event (&rest event-slots
&key event-key root code state
(defun input-handle-key-press-event (&rest event-slots
&key event-key root code state
&allow-other-keys)
(declare (ignore event-slots root))
(let ((numlock-on-p (= 2 (logand 2 (nth-value 4 (xlib:keyboard-control *display*)))))
@ -392,7 +391,7 @@ position. @var{input} must be of type @var{input-line}. Input
functions are passed this structure as their first argument."
(check-type string string)
(loop for c across string
do (input-insert-char input c)))
do (input-insert-char input c)))
(defun input-point (input)
"Return the position of the cursor."

10
kmap.lisp
View file

@ -27,11 +27,11 @@
(export '(*top-map*
*root-map*
define-key
kbd
lookup-command
lookup-key
make-sparse-keymap
undefine-key))
kbd
lookup-command
lookup-key
make-sparse-keymap
undefine-key))
(defvar *top-map* nil
"The top level key map. This is where you'll find the binding for the

16
manual.lisp
View file

@ -92,11 +92,11 @@
(let ((*print-case* :downcase))
(with-open-file (os out :direction :output :if-exists :supersede)
(with-open-file (is in :direction :input)
(loop for line = (read-line is nil is)
until (eq line is) do
(or (generate-function-doc os line)
(generate-macro-doc os line)
(generate-hook-doc os line)
(generate-variable-doc os line)
(generate-command-doc os line)
(write-line line os)))))))
(loop for line = (read-line is nil is)
until (eq line is) do
(or (generate-function-doc os line)
(generate-macro-doc os line)
(generate-hook-doc os line)
(generate-variable-doc os line)
(generate-command-doc os line)
(write-line line os)))))))

2
module.lisp
View file

@ -30,7 +30,7 @@
*load-path*
*module-dir*
init-load-path
set-module-dir
set-module-dir
find-module
add-to-load-path))

10
screen.lisp
View file

@ -27,11 +27,11 @@
(export '(current-screen
current-window
screen-current-window
screen-number
screen-groups
screen-windows
screen-height
screen-width
screen-number
screen-groups
screen-windows
screen-height
screen-width
set-fg-color
set-bg-color
set-border-color

24
stumpwm.lisp
View file

@ -23,7 +23,7 @@
(in-package :stumpwm)
(export '(*toplevel-io*
stumpwm
stumpwm
call-in-main-thread
in-main-thread-p
push-event))
@ -64,7 +64,7 @@ further up. "
(defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys)
"Handle X errors"
(cond
(cond
;; ignore asynchronous window errors
((and asynchronous
(find error-key '(xlib:window-error xlib:drawable-error xlib:match-error)))
@ -93,7 +93,7 @@ further up. "
(when (and (find-restart :remove-channel)
(not (typep *current-io-channel*
'(or stumpwm-timer-channel
display-channel
display-channel
request-channel))))
(message "Removed channel ~S due to uncaught error '~A'." *current-io-channel* c)
(invoke-restart :remove-channel))
@ -210,18 +210,18 @@ further up. "
(defun parse-display-string (display)
"Parse an X11 DISPLAY string and return the host and display from it."
(ppcre:register-groups-bind (protocol host ('parse-integer display screen))
("^(?:(.*?)/)?(.*?)?:(\\d+)(?:\\.(\\d+))?" display :sharedp t)
(values
("^(?:(.*?)/)?(.*?)?:(\\d+)(?:\\.(\\d+))?" display :sharedp t)
(values
;; clx doesn't like (vector character *)
(coerce (or host "")
'(simple-array character (*)))
'(simple-array character (*)))
display screen
(cond (protocol
(intern1 protocol :keyword))
((or (string= host "")
(string-equal host "unix"))
:local)
(t :internet)))))
(intern1 protocol :keyword))
((or (string= host "")
(string-equal host "unix"))
:local)
(t :internet)))))
(defun stumpwm-internal (display-str)
(multiple-value-bind (host display screen protocol) (parse-display-string display-str)
@ -287,7 +287,7 @@ further up. "
(setf *last-unhandled-error* nil)
(cond ((and (consp ret)
(typep (first ret) 'condition))
(format t "~&Caught '~a' at the top level. Please report this.~%~a"
(format t "~&Caught '~a' at the top level. Please report this.~%~a"
(first ret) (second ret))
(setf *last-unhandled-error* ret))
;; we need to jump out of the event loop in order to hup

40
tile-group.lisp
View file

@ -273,16 +273,16 @@
"Return a Y for frame that doesn't overlap the mode-line."
(let* ((head (frame-head group frame))
(ml (head-mode-line head))
(head-y (frame-y head))
(rel-frame-y (- (frame-y frame) head-y)))
(head-y (frame-y head))
(rel-frame-y (- (frame-y frame) head-y)))
(if (and ml (not (eq (mode-line-mode ml) :hidden)))
(case (mode-line-position ml)
(:top
(+ head-y
(+ (mode-line-height ml) (round (* rel-frame-y (mode-line-factor ml))))))
(+ (mode-line-height ml) (round (* rel-frame-y (mode-line-factor ml))))))
(:bottom
(+ head-y
(round (* rel-frame-y (mode-line-factor ml))))))
(round (* rel-frame-y (mode-line-factor ml))))))
(frame-y frame))))
(defun frame-display-height (group frame)
@ -858,19 +858,19 @@ desktop when starting."
(halfwidth (/ width 2)))
(when (> width 0)
(let ((x (frame-x f))
(y (frame-display-y group f))
(w (frame-width f))
(h (frame-display-height group f)))
(when tl
(xlib:draw-line win gc
x (+ halfwidth y) w 0 t)
(xlib:draw-line win gc
(+ halfwidth x) y 0 h t))
(when br
(xlib:draw-line win gc
(+ x (- w halfwidth)) y 0 h t)
(xlib:draw-line win gc
x (+ y (- h halfwidth)) w 0 t))))))
(y (frame-display-y group f))
(w (frame-width f))
(h (frame-display-height group f)))
(when tl
(xlib:draw-line win gc
x (+ halfwidth y) w 0 t)
(xlib:draw-line win gc
(+ halfwidth x) y 0 h t))
(when br
(xlib:draw-line win gc
(+ x (- w halfwidth)) y 0 h t)
(xlib:draw-line win gc
x (+ y (- h halfwidth)) w 0 t))))))
(defun draw-frame-outlines (group &optional head)
"Draw an outline around all frames in GROUP."
@ -1265,7 +1265,7 @@ direction. The following are valid directions:
"Transform all floating windows in this group to tiled windows.
Puts all tiled windows in the first frame of the group. "
(let ((group (current-group)))
(mapc (lambda (w)
(when (typep w 'float-window)
(unfloat-window w group)))
(mapc (lambda (w)
(when (typep w 'float-window)
(unfloat-window w group)))
(head-windows group (current-head)))))

12
tile-window.lisp
View file

@ -529,10 +529,10 @@ frame. Possible values are:
frame and focus the selected window. The optional argument @var{fmt} can be
specified to override the default window formatting."
(let* ((group (current-group))
(frame (tile-group-current-frame group)))
(frame (tile-group-current-frame group)))
(if (null (frame-windows group frame))
(message "No Managed Windows")
(let ((window (select-window-from-menu (frame-sort-windows group frame) fmt)))
(if window
(group-focus-window group window)
(throw 'error :abort))))))
(message "No Managed Windows")
(let ((window (select-window-from-menu (frame-sort-windows group frame) fmt)))
(if window
(group-focus-window group window)
(throw 'error :abort))))))

26
time.lisp
View file

@ -37,10 +37,10 @@
(in-package :stumpwm)
(export '(*time-format-string-default*
*time-modeline-string*
time-format
echo-date
time))
*time-modeline-string*
time-format
echo-date
time))
(defvar *time-format-string-default* "%a %b %e %Y %k:%M:%S"
"The default value for `echo-date', (e.g, Thu Mar 3 2005 23:05:25).")
@ -138,12 +138,12 @@
(defun time-hour-12hr ()
(let ((hour (rem (getf (time-plist) :hour) 12)))
(format nil "~2,D"
(if (zerop hour) 12 hour))))
(if (zerop hour) 12 hour))))
(defun time-hour-12hr-zero ()
(let ((hour (rem (getf (time-plist) :hour) 12)))
(format nil "~2,'0D"
(if (zerop hour) 12 hour))))
(if (zerop hour) 12 hour))))
(defun time-day-of-month-zero ()
(format nil "~2,'0D" (getf (time-plist) :dom)))
@ -198,15 +198,15 @@
(defun time-tz ()
(let ((tz (getf (time-plist) :tz))
(dlsave (if (getf (time-plist) :dlsavings-p) 1 0)))
(dlsave (if (getf (time-plist) :dlsavings-p) 1 0)))
(multiple-value-bind (hour-local decimal-local)
(truncate (+ (* (float tz) -1)
(if dlsave 1 0)))
(truncate (+ (* (float tz) -1)
(if dlsave 1 0)))
(format nil "~A~2,'0D~2,'0D"
(if (> hour-local 0) '+ '-)
(abs hour-local)
(truncate (if (/= decimal-local 0)
(* 60 decimal-local) 0))))))
(if (> hour-local 0) '+ '-)
(abs hour-local)
(truncate (if (/= decimal-local 0)
(* 60 decimal-local) 0))))))
(defun time-unix-era ()
(format nil "~D" (sb-posix:time)))

14
timers.lisp
View file

@ -18,15 +18,15 @@
;; <http://www.gnu.org/licenses/>.
;; Commentary:
;;
;;
;; Provides the code for timers.
;;
;; Code:
(in-package :stumpwm)
(export '(cancel-timer
timer-p
timer-p
idle-time
run-with-timer))
run-with-timer))
;;; Timers
@ -45,10 +45,10 @@
(defun idle-time (screen)
"Returns the time in seconds since idle according to the root window
of the `screen'."
(/ (first (multiple-value-list
(xlib:screen-saver-get-idle
(/ (first (multiple-value-list
(xlib:screen-saver-get-idle
*display* (screen-root screen))))
1000.0))
1000.0))
(defun run-with-timer (secs repeat function &rest args)
"Perform an action after a delay of SECS seconds.
@ -65,7 +65,7 @@ The action is to call FUNCTION with arguments ARGS."
(schedule-timer timer secs)
(labels ((append-to-list ()
(sb-thread:with-mutex (*timer-list-lock*)
(setf *timer-list* (merge 'list *timer-list* (list timer)
(setf *timer-list* (merge 'list *timer-list* (list timer)
#'< :key #'timer-time)))))
(call-in-main-thread #'append-to-list)
timer)))

12
user.lisp
View file

@ -26,11 +26,11 @@
(export '(defprogram-shortcut
pathname-is-executable-p
programs-in-path
restarts-menu
run-or-raise
programs-in-path
restarts-menu
run-or-raise
run-or-pull
run-shell-command
run-shell-command
window-send-string))
(defun restarts-menu (err)
@ -149,7 +149,7 @@ seperated by a colon."
with base. Automagically update the cache."
(rehash)
(remove-if-not #'(lambda (p)
(when (<= (length base) (length p))
(when (<= (length base) (length p))
(string= base p
:end1 (length base)
:end2 (length base)))) (path-cache-programs *path-cache*)))
@ -235,7 +235,7 @@ made and you wish to replace the existing process with it.
Any run-time customizations will be lost after the restart."
(throw :top-level :hup-process))
(defun find-matching-windows (props all-groups all-screens)
"Returns list of windows matching @var{props} (see run-or-raise
documentation for details). @var{all-groups} will find windows on all

2
window-placement.lisp
View file

@ -24,7 +24,7 @@
(defun get-or-create-rule-scanner (regex)
(or (gethash regex *rule-scanners-cache*)
(setf (gethash regex *rule-scanners-cache*)
(ppcre:create-scanner regex))))
(ppcre:create-scanner regex))))
(defun string-match (string pat)
(ppcre:scan (get-or-create-rule-scanner pat) string))

54
window.lisp
View file

@ -425,11 +425,11 @@ _NET_WM_STATE_DEMANDS_ATTENTION set"
(defmethod sort-windows-by-class ((window-list list))
"Return a copy of the provided window list sorted by class then by number."
(sort1 window-list (lambda (w1 w2)
(let ((class1 (window-class w1))
(class2 (window-class w2)))
(if (string= class1 class2)
(< (window-number w1) (window-number w2))
(string< class1 class2))))))
(let ((class1 (window-class w1))
(class2 (window-class w2)))
(if (string= class1 class2)
(< (window-number w1) (window-number w2))
(string< class1 class2))))))
(defmethod sort-windows-by-class (group)
"Return a copy of the provided window list sorted by class then by number."
@ -693,22 +693,22 @@ and bottom_end_x."
key))
(key-modifiers-exist-p (key)
(and
(or (not (key-meta key)) (modifiers-meta *modifiers*))
(or (not (key-alt key)) (modifiers-alt *modifiers*))
(or (not (key-hyper key)) (modifiers-hyper *modifiers*))
(or (not (key-super key)) (modifiers-super *modifiers*))))
(or (not (key-meta key)) (modifiers-meta *modifiers*))
(or (not (key-alt key)) (modifiers-alt *modifiers*))
(or (not (key-hyper key)) (modifiers-hyper *modifiers*))
(or (not (key-super key)) (modifiers-super *modifiers*))))
(grabit (w key)
(loop for code in (multiple-value-list (xlib:keysym->keycodes *display* (key-keysym key)))
;; some keysyms aren't mapped to keycodes so just ignore them.
when (and code (key-modifiers-exist-p key))
do
when (and code (key-modifiers-exist-p key))
do
;; Some keysyms, such as upper case letters, need the
;; shift modifier to be set in order to grab properly.
(let ((key
(if (and (not (eql (key-keysym key) (xlib:keycode->keysym *display* code 0)))
(eql (key-keysym key) (xlib:keycode->keysym *display* code 1)))
(add-shift-modifier key)
key)))
(if (and (not (eql (key-keysym key) (xlib:keycode->keysym *display* code 0)))
(eql (key-keysym key) (xlib:keycode->keysym *display* code 1)))
(add-shift-modifier key)
key)))
(xlib:grab-key w code
:modifiers (x11-mods key) :owner-p t
:sync-pointer-p nil :sync-keyboard-p nil)
@ -967,8 +967,8 @@ needed."
@var{fmt} argument specifies the window formatting used. Returns the window
selected."
(second (select-from-menu (current-screen)
(mapcar (lambda (w)
(list (format-expand *window-formatters* fmt w) w))
(mapcar (lambda (w)
(list (format-expand *window-formatters* fmt w) w))
windows)
prompt
(or (position (current-window) windows) 0) ; Initial selection
@ -1067,16 +1067,16 @@ is using the number, then the windows swap numbers. Defaults to current group."
(defcommand repack-window-numbers (&optional preserved) ()
"Ensure that used window numbers do not have gaps; ignore PRESERVED window numbers."
(let* ((group (current-group))
(windows (sort-windows group)))
(windows (sort-windows group)))
(loop for w in windows
do (unless (find (window-number w) preserved)
(setf
(window-number w)
(find-free-number
(remove
(window-number w)
(mapcar 'window-number windows))
0))))))
do (unless (find (window-number w) preserved)
(setf
(window-number w)
(find-free-number
(remove
(window-number w)
(mapcar 'window-number windows))
0))))))
;; It would make more sense that the window-list argument was before the fmt one
;; but window-list was added latter and I didn't want to break other's code.
@ -1091,7 +1091,7 @@ all window in the current group. Also note that the default window list is sorte
by number and if the @var{windows-list} is provided, it is shown unsorted (as-is)."
;; Shadowing the window-list argument.
(let ((window-list (or window-list
(sort-windows-by-number
(sort-windows-by-number
(group-windows (current-group))))))
(if (null window-list)
(message "No Managed Windows")

32
wrappers.lisp
View file

@ -128,19 +128,19 @@
"READ-LINE, but with a workaround for a known SBCL/Linux bug
regarding files in sysfs. Data is read in chunks of BLOCKSIZE bytes."
(let ((buf (make-array blocksize
:element-type '(unsigned-byte 8)
:initial-element 0))
(fd (sb-sys:fd-stream-fd stream))
(string-filled 0)
(string (make-string blocksize))
bytes-read
pos
(stringlen blocksize))
:element-type '(unsigned-byte 8)
:initial-element 0))
(fd (sb-sys:fd-stream-fd stream))
(string-filled 0)
(string (make-string blocksize))
bytes-read
pos
(stringlen blocksize))
(loop
;; Read in the raw bytes
(setf bytes-read
(sb-unix:unix-read fd (sb-sys:vector-sap buf) blocksize))
(sb-unix:unix-read fd (sb-sys:vector-sap buf) blocksize))
;; Why does SBCL return NIL when an error occurs?
(when (or (null bytes-read)
@ -152,20 +152,20 @@ regarding files in sysfs. Data is read in chunks of BLOCKSIZE bytes."
;; Resize the string if necessary.
(when (> (+ pos string-filled) stringlen)
(setf stringlen (max (+ pos string-filled)
(* 2 stringlen)))
(let ((new (make-string stringlen)))
(replace new string)
(setq string new)))
(setf stringlen (max (+ pos string-filled)
(* 2 stringlen)))
(let ((new (make-string stringlen)))
(replace new string)
(setq string new)))
;; Translate read bytes to string
(setf (subseq string string-filled)
(sb-ext:octets-to-string (subseq buf 0 pos)))
(sb-ext:octets-to-string (subseq buf 0 pos)))
(incf string-filled pos)
(if (< pos blocksize)
(return (subseq string 0 string-filled))))))
(return (subseq string 0 string-filled))))))
(defun execv (program &rest arguments)
(declare (ignorable program arguments))

52
wse.lisp
View file

@ -30,10 +30,10 @@
(let*
((group
(if (stringp arggroup)
(or
(find-group (current-screen) arggroup)
(add-group (current-screen) arggroup))
(or arggroup (current-group)))))
(or
(find-group (current-screen) arggroup)
(add-group (current-screen) arggroup))
(or arggroup (current-group)))))
(mapcar (lambda (w) (move-window-to-group w group)) windows)))
(defgeneric
@ -71,74 +71,86 @@
`(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))))
(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 &optional g)
"Pull the window w: to the current group or to the specified group g."
(move-windows-to-group (list w) (or g (current-group))))
(defun titled-p (w title)
"Check whether window title of the window w is equal to the string
title."
(equal (window-title w) title))
(defun title-re-p (w tre)
"Check whether the window title of the window w matches the regular
expression tre."
(cl-ppcre:scan tre (window-title w)))
(defun classed-p (w class)
"Check whether the window class of the window w is equal to the string
class."
(equal (window-class w) class))
(defun class-re-p (w cre)
"Check whether the window class of the window w matches the regular
expression cre."
(cl-ppcre:scan cre (window-class w)))
(defun typed-p (w type)
"Check whether the window type of the window w is equal to the string
type."
(equal (window-type w) type))
(defun type-re-p (w tre)
"Check whether the window type of the window w matches the regular
expression tre."
(cl-ppcre:scan tre (window-type w)))
(defun roled-p (w role)
"Check whether the window role of the window w is equal to the string
role."
(equal (window-role w) role))
(defun role-re-p (w rre)
"Check whether the window role of the window w matches the regular
expression rre."
(cl-ppcre:scan rre (window-role w)))
(defun resed-p (w res)
"Check whether the window resource of the window w is equal to the
string res."
(equal (window-res w) res))
(defun res-re-p (w rre)
"Check whether the window resource of the window w matches the regular
expression rre."
(cl-ppcre:scan rre (window-res w)))
(defun grouped-p (w &optional name)
"Check whether the window w belongs to the group name or the current
group if name is not specified."
(if name
(equal name (group-name (window-group w)))
(equal (window-group w) (current-group))))
(defun in-frame-p (w &optional f)
"Check whether the window w belongs to the frame f or to the current
frame if the frame is not specified."
(eq (window-frame w)
(or f (tile-group-current-frame
(current-group (current-screen))))))
(current-group (current-screen))))))