From 8179c0025a44a769ab6ad2e5c0a58f545517280c Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 17 Jan 2024 00:24:11 -0600
Subject: Change organization and massively refactor

---
 bin/acdwm.scm | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100755 bin/acdwm.scm

(limited to 'bin/acdwm.scm')

diff --git a/bin/acdwm.scm b/bin/acdwm.scm
new file mode 100755
index 0000000..cfa5983
--- /dev/null
+++ b/bin/acdwm.scm
@@ -0,0 +1,55 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec csi -s "$0" "$@"                  ; acdwm
+|#
+
+(import (chicken condition)
+        (acdwm util)
+        (acdwm xlib)
+        (acdwm keys)
+        (acdwm events))
+
+;;; Configuration
+;; TODO: this should go in its own file
+(bind "M-<F1>" (lambda (ev dpy)
+                 (let ((win (xevent-xkey-subwindow ev)))
+                   (when (some? win)
+                     (xraisewindow dpy win)))))
+(bind "M-b1" (lambda (ev dpy)
+               (xraisewindow dpy (xevent-xbutton-subwindow ev))
+               (initialize-drag 'move ev)))
+(bind "M-b3" (lambda (ev dpy)
+               (xraisewindow dpy (xevent-xbutton-subwindow ev))
+               (initialize-drag 'resize ev)))
+
+;;; Main entry point
+
+(define (acdwm-setup)
+  (or (get-display)
+      (error "Can't capture display"))
+  (grab-input))
+
+(define (acdwm-cleanup)
+  (dprint "Cleaning up"))
+
+(define (main args)
+  (parameterize ((DEBUG #t))
+    (dprint "acdwm: starting up")
+    (dynamic-wind acdwm-setup
+                  (lambda ()
+                    (call/cc
+                     (lambda (k)
+                       (with-exception-handler
+                           (lambda (exn)
+                             (xclosedisplay (get-display))
+                             (k exn))
+                         handle-events))))
+                  acdwm-cleanup))
+  (xclosedisplay (get-display))
+  (exit))
+
+(cond-expand
+  ((or chicken-script compiling)
+   (import (chicken process-context))
+   (main (command-line-arguments)))
+  (else))
-- 
cgit 1.4.1-21-gabe81