pinwin.lsp

   1 #!/usr/local/bin/newlisp
   2 # Copyright 2018, Ralph Ronnquist <ralph.ronnquist@gmail.com>
   3
   4 ; This newlisp script is a "daemon" to make the right-hand monitor (in
   5 ; a horizontal Xinerama set up) "sticky". The script listens to X
   6 ; events so as to discover that a window is moved, and acts on it when
   7 ; it's placed. Specifically, when a window is placed to the right of
   8 ; the EDGE, it is pinned to be on all workspaces, and when it's placed
   9 ; to the left of the EDGE, it's unpinnned to be on the current
  10 ; workspace only.
  11 ;
  12 ; https://tronche.com/gui/x/xlib/
  13 ; http://refspecs.linuxfoundation.org/LSB_3.1.1/LSB-Desktop-generic/LSB-Desktop-generic/libx11-ddefs.html
  14 ; https://specifications.freedesktop.org/wm-spec/1.3/index.html
  15 ; https://www.x.org/archive/X11R7.7/doc/man/man3/Xinerama.3.xhtml
  16
  17 ; Set up to die on ^C
  18 (define (die x) (exit 0)) (signal 2 die)
  19
  20 ; Utility to return the first of a series of terms.
  21 (define (prog1) (args 0))
  22
  23 ; Read macro for the address at a byte offset <N> into block <P>.
  24 (macro (p@ P N) (+ (address P) N))
  25
  26 ; Utility to unpack a packed binary array at <p> of <n> layout <s>
  27 ; records with <w> fields each.
  28 (define (unpack-array s w n p) (explode (unpack (dup s n) p) w))
  29
  30 ; Making them available in all contexts.
  31 (global 'prog1 'p@ 'unpack-array)
  32
  33 (context 'MAIN:X11) ; API for libX11.so
  34 (constant 'LIB "/usr/lib/x86_64-linux-gnu/libX11.so") ; Devuan 2.0
  35
  36 (import LIB "XDefaultRootWindow" "void*"
  37         "void*" ; display
  38         )
  39 (import LIB "XFree" "void"
  40         "void*" ; data
  41         )
  42 (import LIB "XGetWindowProperty" "int"
  43         "void*" "void*" "long" ; display, window, property(atom)
  44         "long" "long" "int" "long" ; long_offset, long_length, delete, req_type
  45         "void*" "void*" ; actual_type_return, actual_format_return
  46         "void*" "void*" ; nitems_return, bytes_after_return
  47         "void*" ; prop_return
  48         )
  49 (struct 'XGetWindowProperty_return
  50         "long" ; actual_type_return
  51         "int" ; actual_format_return
  52         "long" ; nitems_return
  53         "long" ; bytes_after_return
  54         "void*" ; prop_return
  55         )
  56 (import LIB "XInternAtom" "long"
  57         "void*" "char*" "int" ; display, atom_name, only_if_exists
  58         )
  59 (import LIB "XNextEvent" "void"
  60         "void*" "void*" ; display, window
  61         )
  62 (import LIB "XSendEvent" "int"
  63         "void*" "void*" ; display, window
  64         "int" "long" "void*"
  65         )
  66 (import LIB "XOpenDisplay" "void*"
  67         "void*" ; display
  68         )
  69 (import LIB "XQueryTree" "int"
  70         "void*" "void*" ; display, window
  71         "void*" "void*" ; root_return, parent_return
  72         "void*" "void*" ; children_return, nchildren_return
  73         )
  74 (struct 'XQueryTree_return
  75         "long" "long" ; root_return, parent_return
  76         "long" "int" ; children_return, nchildren_return
  77         )
  78 (import LIB "XSelectInput" "void"
  79         "void*" "void*" "long" ; display, window, mask
  80         )
  81 (struct 'XConfigureEvent
  82         "int" "long" "int" ; type, serial, send_event
  83         "void*" "void*" "void*" ; display, event, window
  84         "int" "int" "int" "int" "int" ; x, y, width, height, border_width
  85         "void*" "int" ; above, override_redirect
  86         )
  87 (struct 'XCrossingEvent
  88         "int" "long" "int" ; type, serial, send_event
  89         "void*" "void*" "void*" "void*" ; display, window, root, subwindow
  90         "long" ; time
  91         "int" "int" "int" "int" ; x, y, x_root, y_root
  92         "int" "int" ; mode, detail
  93         "int" "int" "int" ; same_screen, focus, state
  94         )
  95 (struct 'XClientMessageEvent
  96         "int" "long" "int" ; type, serial, send_event
  97         "void*" "void*" "void*" "void*" ; display, window
  98         "long" "int" ; message_type, format
  99         "long" "long" "long" "long" "long" ; data
 100         )
 101
 102 ; Initializing the X client, and defining some constants.
 103 (constant
 104  'display (XOpenDisplay 0)
 105  'root (XDefaultRootWindow display)
 106  '_NET_CURRENT_DESKTOP (XInternAtom display "_NET_CURRENT_DESKTOP" 1)
 107  '_NET_WM_DESKTOP (XInternAtom display "_NET_WM_DESKTOP" 1)
 108  'LeaveWindowMask        (<< 1 5)
 109  'SubstructureNotifyMask (<< 1 19)
 110  'PropertyChangeMask     (<< 1 22)
 111  'LeaveNotify 8
 112  'ConfigureNotify 22
 113  )
 114
 115 ; Utility wrapping for XNextEvent. The "event" argument is the union
 116 ; of all possible event types, which all fit in a block of 24 long
 117 ; integers (192 bytes).
 118 (define (nextEvent)
 119   (let ((e (dup "\000" 192))) (XNextEvent display (p@ e 0)) e ))
 120
 121 ; Utility to map an X layer window to its "application window", which
 122 ; is the last child of the X layer window. This uses XQueryTree which
 123 ; has many return values (see XQueryTree_return). Note that the
 124 ; returned children array (r 2) is malloc-ed, and it needs to be
 125 ; XFree-ed.
 126 (define (app-window w)
 127   (let ((r (pack XQueryTree_return 0 0 0 0)))
 128     (when (!= (XQueryTree display w (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24)))
 129       (setf r (unpack XQueryTree_return r))
 130       (prog1 (if (!= (r 3)) ((unpack-array "Lu" 1 (r 3) (r 2)) -1 0))
 131         (XFree (r 2))))))
 132
 133 ; Utility to obtain a long-valued property (atom named) from a window.
 134 (define (get-property w a)
 135   (let ((r (pack XGetWindowProperty_return 0 0 0 0 0)))
 136     (when (XGetWindowProperty display w a 0 1 0 0
 137                (p@ r 0) (p@ r 8) (p@ r 16) (p@ r 24) (p@ r 32))
 138       (setf r (last (unpack XGetWindowProperty_return r)))
 139       (when (!= r) (prog1 ((unpack "ld" r) 0) (XFree r) )))))
 140
 141 ; Utility to obtain the current workspace. This is maintained as a
 142 ; property of the root window. (Called "desktop" in ancient times)
 143 (define (current-workspace) (get-property root _NET_CURRENT_DESKTOP ) )
 144
 145 ; Utility to obtain the worskpace property of a window.
 146 (define (window-workspace w) (and w (get-property w _NET_WM_DESKTOP )) )
 147
 148 ; Utility to set the workspace property for a window. Note that the
 149 ; targeted "application window" to pin or unpin is actually a child of
 150 ; the given X layer window (or "window manager window").
 151 (define (set-window-workspace w dt)
 152   (let ((aw (app-window w)))
 153     (and aw (!= dt (window-workspace aw))
 154          (XSendEvent display root 0 PropertyChangeMask
 155                      (pack XClientMessageEvent 33 0 0 display aw
 156                            _NET_WM_DESKTOP 32 dt 2 0 0 0) )) ))
 157
 158 (context 'MAIN:Xinerama) ; API for libXinerama.so
 159 (constant 'LIB "/usr/lib/x86_64-linux-gnu/libXinerama.so.1") ; Devuan 2.0
 160
 161 (import LIB "XineramaQueryScreens" "void*" ; XineramaScreenInfo*
 162         "void*" ; Display *display
 163         "void*" ; int *number
 164         )
 165 (struct 'XineramaScreenInfo
 166         "int" ; monitor index
 167         "short int" "short int" "short int" "short int" ; x, y, width, height
 168         )
 169
 170 ; Utility to obtain the list of monitor physical dimensions
 171 ; Returns: ((id x y w h) ... )
 172 (define (queryScreens)
 173   (letn ((e (pack "lu" 0))
 174          (p (XineramaQueryScreens X11:display (p@ e 0)))
 175          (n ((unpack "lu" e) 0)))
 176     (when (!= n) (prog1 (unpack-array "luuuuu" 5 n p) (X11:XFree p)))
 177     ))
 178
 179 (context MAIN) ; ---- The main application starts here ----
 180
 181 (setf
 182  EDGE ((Xinerama:queryScreens) 0 3) ; width of monitor 0
 183  window nil ; last moved window and position (id x y)
 184  )
 185
 186 ; Handle XConfigureEvent by capturing window id and top-left
 187 ; coordinates. These events are issued while a window is moved. The
 188 ; last of them thus tells the last placement of the moved window.
 189 (define (Configure e)
 190   (setf window (select (unpack X11:XConfigureEvent e) 5 6 7)))
 191
 192 ; Handle XCrossingEvent events, identifying the "ungrab event" after
 193 ; having moved a window (i.e., releasing it at its last placement). At
 194 ; then, the most recently moved window is reviewed for placement, and
 195 ; its "workspace placement property" is set depending on where the
 196 ; window is relative to EDGE; either to the current workspace, or to
 197 ; -1, which means "all workspaces".
 198 (define (Leave e)
 199   (when (and window (= (& (last (unpack X11:XCrossingEvent e)) 0x100)))
 200     (X11:set-window-workspace (window 0)
 201      (if (>= (window 1) EDGE) -1 (X11:current-workspace))) ))
 202
 203  ; Set up to receive certain events only.
 204 (X11:XSelectInput
 205  X11:display X11:root (| X11:SubstructureNotifyMask X11:LeaveWindowMask ))
 206
 207 ; Handle X events until the cows go home.
 208 (letex ((L X11:LeaveNotify) (C X11:ConfigureNotify))
 209   (while (setf e (X11:nextEvent))
 210     (case ((unpack "lu" e) 0) ; the event type
 211       ( L (Leave e))
 212       ( C (Configure e))
 213       (true nil)) ))
 214
 215 (exit)