Various newlisp scripts.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

216 lines
8.1 KiB

3 years ago
# Copyright 2018, Ralph Ronnquist <>
; This newlisp script is a "daemon" to make the right-hand monitor (in
; a horizontal Xinerama set up) "sticky". The script listens to X
; events so as to discover that a window is moved, and acts on it when
; it's placed. Specifically, when a window is placed to the right of
; the EDGE, it is pinned to be on all workspaces, and when it's placed
; to the left of the EDGE, it's unpinnned to be on the current
; workspace only.
; Set up to die on ^C
(define (die x) (exit 0)) (signal 2 die)
; Utility to return the first of a series of terms.
(define (prog1) (args 0))
; Read macro for the address at a byte offset <N> into block <P>.
(macro (p@ P N) (+ (address P) N))
; Utility to unpack a packed binary array at <p> of <n> layout <s>
; records with <w> fields each.
(define (unpack-array s w n p) (explode (unpack (dup s n) p) w))
; Making them available in all contexts.
(global 'prog1 'p@ 'unpack-array)
(context 'MAIN:X11) ; API for
(constant 'LIB "/usr/lib/x86_64-linux-gnu/") ; Devuan 2.0
(import LIB "XDefaultRootWindow" "void*"
"void*" ; display
(import LIB "XFree" "void"
"void*" ; data
(import LIB "XGetWindowProperty" "int"
"void*" "void*" "long" ; display, window, property(atom)
"long" "long" "int" "long" ; long_offset, long_length, delete, req_type
"void*" "void*" ; actual_type_return, actual_format_return
"void*" "void*" ; nitems_return, bytes_after_return
"void*" ; prop_return
(struct 'XGetWindowProperty_return
"long" ; actual_type_return
"int" ; actual_format_return
"long" ; nitems_return
"long" ; bytes_after_return
"void*" ; prop_return
(import LIB "XInternAtom" "long"
"void*" "char*" "int" ; display, atom_name, only_if_exists
(import LIB "XNextEvent" "void"
"void*" "void*" ; display, window
(import LIB "XSendEvent" "int"
"void*" "void*" ; display, window
"int" "long" "void*"
(import LIB "XOpenDisplay" "void*"
"void*" ; display
(import LIB "XQueryTree" "int"
"void*" "void*" ; display, window
"void*" "void*" ; root_return, parent_return
"void*" "void*" ; children_return, nchildren_return
(struct 'XQueryTree_return
"long" "long" ; root_return, parent_return
"long" "int" ; children_return, nchildren_return
(import LIB "XSelectInput" "void"
"void*" "void*" "long" ; display, window, mask
(struct 'XConfigureEvent
"int" "long" "int" ; type, serial, send_event
"void*" "void*" "void*" ; display, event, window
"int" "int" "int" "int" "int" ; x, y, width, height, border_width
"void*" "int" ; above, override_redirect
(struct 'XCrossingEvent
"int" "long" "int" ; type, serial, send_event
"void*" "void*" "void*" "void*" ; display, window, root, subwindow
"long" ; time
"int" "int" "int" "int" ; x, y, x_root, y_root
"int" "int" ; mode, detail
"int" "int" "int" ; same_screen, focus, state
(struct 'XClientMessageEvent
"int" "long" "int" ; type, serial, send_event
"void*" "void*" "void*" "void*" ; display, window
"long" "int" ; message_type, format
"long" "long" "long" "long" "long" ; data
; Initializing the X client, and defining some constants.
'display (XOpenDisplay 0)
'root (XDefaultRootWindow display)
'_NET_WM_DESKTOP (XInternAtom display "_NET_WM_DESKTOP" 1)
'LeaveWindowMask (<< 1 5)
'SubstructureNotifyMask (<< 1 19)
'PropertyChangeMask (<< 1 22)
'LeaveNotify 8
'ConfigureNotify 22
; Utility wrapping for XNextEvent. The "event" argument is the union
; of all possible event types, which all fit in a block of 24 long
; integers (192 bytes).
(define (nextEvent)
(let ((e (dup "\000" 192))) (XNextEvent display (p@ e 0)) e ))
; Utility to map an X layer window to its "application window", which
; is the last child of the X layer window. This uses XQueryTree which
; has many return values (see XQueryTree_return). Note that the
; returned children array (r 2) is malloc-ed, and it needs to be
; XFree-ed.
(define (app-window w)
(let ((r (pack XQueryTree_return 0 0 0 0)))
(when (!= (XQueryTree display w (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24)))
(setf r (unpack XQueryTree_return r))
(prog1 (if (!= (r 3)) ((unpack-array "Lu" 1 (r 3) (r 2)) -1 0))
(XFree (r 2))))))
; Utility to obtain a long-valued property (atom named) from a window.
(define (get-property w a)
(let ((r (pack XGetWindowProperty_return 0 0 0 0 0)))
(when (XGetWindowProperty display w a 0 1 0 0
(p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24) (p@ r 32))
(setf r (last (unpack XGetWindowProperty_return r)))
(when (!= r) (prog1 ((unpack "ld" r) 0) (XFree r) )))))
; Utility to obtain the current workspace. This is maintained as a
; property of the root window. (Called "desktop" in ancient times)
(define (current-workspace) (get-property root _NET_CURRENT_DESKTOP ) )
; Utility to obtain the worskpace property of a window.
(define (window-workspace w) (and w (get-property w _NET_WM_DESKTOP )) )
; Utility to set the workspace property for a window. Note that the
; targeted "application window" to pin or unpin is actually a child of
; the given X layer window (or "window manager window").
(define (set-window-workspace w dt)
(let ((aw (app-window w)))
(and aw (!= dt (window-workspace aw))
(XSendEvent display root 0 PropertyChangeMask
(pack XClientMessageEvent 33 0 0 display aw
_NET_WM_DESKTOP 32 dt 2 0 0 0) )) ))
(context 'MAIN:Xinerama) ; API for
(constant 'LIB "/usr/lib/x86_64-linux-gnu/") ; Devuan 2.0
(import LIB "XineramaQueryScreens" "void*" ; XineramaScreenInfo*
"void*" ; Display *display
"void*" ; int *number
(struct 'XineramaScreenInfo
"int" ; monitor index
"short int" "short int" "short int" "short int" ; x, y, width, height
; Utility to obtain the list of monitor physical dimensions
; Returns: ((id x y w h) ... )
(define (queryScreens)
(letn ((e (pack "lu" 0))
(p (XineramaQueryScreens X11:display (p@ e 0)))
(n ((unpack "lu" e) 0)))
(when (!= n) (prog1 (unpack-array "luuuuu" 5 n p) (X11:XFree p)))
(context MAIN) ; ---- The main application starts here ----
EDGE ((Xinerama:queryScreens) 0 3) ; width of monitor 0
window nil ; last moved window and position (id x y)
; Handle XConfigureEvent by capturing window id and top-left
; coordinates. These events are issued while a window is moved. The
; last of them thus tells the last placement of the moved window.
(define (Configure e)
(setf window (select (unpack X11:XConfigureEvent e) 5 6 7)))
; Handle XCrossingEvent events, identifying the "ungrab event" after
; having moved a window (i.e., releasing it at its last placement). At
; then, the most recently moved window is reviewed for placement, and
; its "workspace placement property" is set depending on where the
; window is relative to EDGE; either to the current workspace, or to
; -1, which means "all workspaces".
(define (Leave e)
(when (and window (= (& (last (unpack X11:XCrossingEvent e)) 0x100)))
(X11:set-window-workspace (window 0)
(if (>= (window 1) EDGE) -1 (X11:current-workspace))) ))
; Set up to receive certain events only.
X11:display X11:root (| X11:SubstructureNotifyMask X11:LeaveWindowMask ))
; Handle X events until the cows go home.
(letex ((L X11:LeaveNotify) (C X11:ConfigureNotify))
(while (setf e (X11:nextEvent))
(case ((unpack "lu" e) 0) ; the event type
( L (Leave e))
( C (Configure e))
(true nil)) ))