organize code in modules

etc/config.scm

@@ -1,4 +1,13 @@
-(include "hooks.scm")
+(use-modules (ice-9 match))
+(use-modules (ice-9 popen))
+(use-modules (ice-9 rdelim))
+(use-modules (gri3 wm))
+(use-modules (gri3 bindings))
+(use-modules (gri3 hooks))
+
+(define mode "default")
+
+(define devel #t)
 
 (display "-- GUILE CONFIGURATION START LOADING --\n")
 
@@ -7,10 +16,10 @@
 	   (list c " &"))))
 
 ;; (include "i3.scm")
-(define font "pango:Fira Mono 12")
+(define font "pango:Hack 8")
 ;; (run-shell-command "./i3bar -b 0")
 
-;; (set-font )
+;; xkb_keysym_from_name(symbol, XKB_KEYSYM_NO_FLAGS)
 
 (define (reload)
   (display "Reloading (with refresh)!\n")
@@ -18,43 +27,9 @@
   (refresh))
 
 (define (urxvt)
-  (display "Starting urxvt\n")
+  (if devel
-  (run-shell-command "urxvt"))
+      (run-shell-command "urxvt")
-
+      (run-shell-command "urxvtc")))
-;; (define (config-bars)
-;;   (bar-start)
-;;   (set-bar-position "top")
-;;   (bar-finish)
-;;   ;; 2 bars
-;;   (bar-start)
-;;   (set-bar-position "bottom")
-;;   (bar-finish)
-;;   (i3bar))
-
-;; ;; (i3bar)
-;; ;; (i3-exec "" "" urxvt)
-
-;; (define (cw)
-;;   (change-workspace "3"))
-
-(define (cw1)
-  (change-workspace "1"))
-
-(define (cw2)
-  (let ((resp (change-workspace "2")))
-    (if (not (boolean? resp))
-	(format #f "~A ~A" (car resp) (cadr resp)))))
-
-(define (cwz)
-  (let ((resp (change-workspace "z")))
-    (if (not (boolean? resp))
-	(format #f "~A ~A" (car resp) (cadr resp)))))
-
-;; (define (default)
-;;   (change-workspace "default"))
-
-(use-modules (ice-9 popen))
-(use-modules (ice-9 rdelim))
 
 (define (run-and-read command)
   (let* ((port (open-input-pipe command))
@@ -62,91 +37,50 @@
     (close-pipe port)
     str))
 
-(define (eval-expr)
+;; (define (urxvt) (display "URXVT"))
-  (run-shell-command (format #f "./i3-msg ~S" (run-and-read "echo '' | dmenu"))))
 
-(set-binding "bindsym" "Mod1" "Return" "" "" "" ""
+(define (eval-expr) (run-shell-command (format #f "./i3-msg ~S" (run-and-read "echo '' | dmenu"))))
-	     (lambda () (urxvt)))
 
-(set-binding "bindsym" "Mod1" "space" "" "" "" ""
+(define (run-program) (run-shell-command "dmenu_run"))
-	     (lambda () (eval-expr)))
 
-(set-binding "bindsym" "Mod1" "r" "" "" "" ""
+(define-mode-map "M-SPC" 'program-launcher)
-	     (lambda () (reload)))
 
-(set-binding "bindsym" "Mod1" "1" "" "" "" ""
+(add-key-binding (kbd "M-m") urxvt)
-	     (lambda () (cw1)))
+(add-key-binding (kbd "M-RET") urxvt)
-(set-binding "bindsym" "Mod1" "2" "" "" "" ""
+(add-key-binding (kbd "M-SPC") run-program)
-	     (lambda () (cw2)))
+(add-key-binding (kbd "M-q") kill-window)
-(set-binding "bindsym" "Mod1" "z" "" "" "" ""
+(add-key-binding (kbd "M-r") reload)
-	     (lambda () (cwz)))
 
-(set-binding "bindsym" "Mod1" "v" "" "" "" ""
+(add-key-binding (kbd "M-r") reload)
-	     (lambda () (split "vertical")))
-(set-binding "bindsym" "Mod1" "h" "" "" "" ""
-	     (lambda () (split "horizontal")))
 
-(set-binding "bindsym" "Mod1" "q" "" "" "" ""
+;; Change layout
-	     (lambda () (kill)))
+(add-key-binding (kbd "M-w") (lambda () (layout "tabbed")))
+(add-key-binding (kbd "M-s") (lambda () (layout "stacked")))
+(add-key-binding (kbd "M-e") (lambda () (toggle-layout "split")))
+;; Split
+(add-key-binding (kbd "M-v") (lambda () (split "vertical")))
+(add-key-binding (kbd "M-h") (lambda () (split "horizontal")))
+;; Add workspaces
+(for-each
+ (lambda (num)
+   (add-key-binding
+    (kbd (format #f "M-~s" num))
+    (lambda () (change-workspace (number->string num))))
+   (add-key-binding
+    (kbd (format #f "M-S-~s" num))
+    (lambda () (move-to-workspace (number->string num)))))
+ '(0 1 2 3 4 5 6 7 8 9))
+;; Move windows
+(add-key-binding (kbd "M-f") (lambda () (focus-direction "right")))
+(add-key-binding (kbd "M-b") (lambda () (focus-direction "left")))
+(add-key-binding (kbd "M-p") (lambda () (focus-direction "up")))
+(add-key-binding (kbd "M-n") (lambda () (focus-direction "down")))
 
-(set-binding "bindsym" "Mod1" "Right" "" "" "" ""
+(when (and (not (defined? 'loaded)) (not devel))
-	     (lambda () (focus-direction "right")))
+  (run-shell-command "setxkbmap && xmodmap ~/.Xmodmap")
+  (run-shell-command "emacs --daemon")
+  (run-shell-command "mcron")
+  (run-shell-command "urxvtd"))
 
-(set-binding "bindsym" "Mod1" "Left" "" "" "" ""
-	     (lambda () (focus-direction "left")))
-
-(set-binding "bindsym" "Mod1" "Up" "" "" "" ""
-	     (lambda () (focus-direction "up")))
-
-(set-binding "bindsym" "Mod1" "Down" "" "" "" ""
-	     (lambda () (focus-direction "down")))
-
-(set-binding "bindsym" "Mod1" "w" "" "" "" ""
-	     (lambda () (layout "tabbed")))
-(set-binding "bindsym" "Mod1" "s" "" "" "" ""
-	     (lambda () (layout "stacked")))
-(set-binding "bindsym" "Mod1" "e" "" "" "" ""
-	     (lambda () (toggle-layout "split")))
-
-;; (set-binding "bindsym" "Mod1" "o" "" "" "" ""
-;; 	     (lambda () (move-to-workspace "2")))
-
-(display "Loaded\n")
-;; (set-binding "bindsym" "Mod2" "Return" "" "" "" "" urxvt)
-
-;; (set-binding "bindsym" "Mod1" "q" "" "" "" "" kill-window)
-;; (set-binding "bindsym" "Mod1" "w" "" "" "" "" kill-client)
-;; (set-binding "bindsym" "Mod1" "1" "" "" "" "" default)
-;; (set-binding "bindsym" "Mod1" "2" "" "" "" "" cw2)
-;; (set-binding "bindsym" "Mod1" "3" "" "" "" "" cw)
-
-;; ;; Con *ws = con_get_workspace(nc)
-;; ;; Con *fs = con_get_fullscreen_covering_ws(ws)
-;; ;; con_move_to_output(nc, output, false);
-;; ;; con_toggle_fullscreen(nc, CF_OUTPUT);
-;; ;; con_move_to_output_name(nc, assignment->dest.output, true);
-
-;; (define (move-to-workspace window workspace)
-;;   (display "Moving window ")
-;;   (display (window-name window))
-;;   (display " to workspace ")
-;;   (display workspace))
-
-;; (define assignments
-;;   ;; #((matcher) assign-function)
-;;   `(("urxvt" ,(lambda () (move-to-workspace "O" "3")))))
-
-;; ;; ((lambda () (+ 2 1)))
-
-;; ;; (define (t i) (display ("ICAO")))
-
-;; ;; ((eval '+) 1 2)
-
-;; ;; (call-with-values (cdr `("urxvt" ,t)) 0)
-
-;; (display "-- GUILE CONFIGURATION LOADED --\n")
 (define loaded #t)
-
+(run-shell-command "feh --randomize --bg-fill ~/memories/incipit/laptop/wallpapers/")
-(run-shell-command "feh --bg-fill ~/freeze/bluescreen_0.png")
-
-;; (split "vertical")

meson.build

@@ -206,4 +206,6 @@ install_data(sources : [ 'etc/config.scm', 'etc/hooks.scm' ], install_dir : 'etc
 install_data(sources : [ 'etc/config.scm', 'etc/hooks.scm' ], install_dir : 'etc/gri3/')
 install_headers('include/ipc.h', subdir : 'gri3')
 install_subdir('share/applications', install_dir : 'share')
-install_subdir('share/xsessions', install_dir : 'share')
+install_subdir('share/xsessions', install_dir : 'share')
+# Guile library
+install_subdir('share/guile', install_dir : 'share')

share/guile/site/3.0/gri3/bindings.scm

@@ -0,0 +1,100 @@
+(define-module (gri3 bindings)
+  #:use-module (gri3 wm)
+  #:use-module (gri3 hooks)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:export
+  (define-mode-map add-key-binding kbd key-press-hook clear-bindings))
+
+(define *bindings* '())
+(define *mode-map* '())
+(define *mode* "default")
+
+(define (sym->name sym)
+  (or (assoc-ref
+       '(("\r" . "Return")
+	 (" " . "space"))
+       sym)
+      sym))
+
+(define (key-press-hook param)
+  (let ((param (list (list-ref param 0) (list-ref param 1) (sym->name (list-ref param 2)))))
+    (apply format #t "~A ~A ~s\n" param)
+    ;; (display *bindings*)
+    ;; (newline)
+    (let ((binding (assoc-ref
+		    *bindings* (list *mode* param))))
+      ;; (display binding)
+      ;; (newline)
+      (if binding
+	  (begin (binding)
+		 #t)
+	  #f))))
+
+(define (clear-bindings) (set! *bindings* '()))
+
+(define (add-key-binding key func)
+  (match-let (((mode (press mod keysym)) key))
+    ;; (format #t "Binding key ~A\n" keysym)
+    ;; get notified for key with all mods
+    (for-each
+     (lambda (mod)
+       (bind-key keysym mod))
+     (list #x8 #x10 #x26 #x40))
+    ;; Store the key+func couple in the list of hooks
+    (set! *bindings*
+	  (assoc-set! *bindings* `("default" (,press ,mod ,keysym)) func))))
+
+(define (special->keysym name)
+  (or (assoc-ref '( ;; ("NUL")
+		   ;; ("REM")
+		   ("RET" . "Return")
+		   ("TAB" . "Tab")
+		   ("LFD" . "Linefeed")
+		   ("ESC" . "Escape")
+		   ("SPC" . "space")
+		   ("DEL" . "Delete"))
+		 name)
+      name))
+
+
+(define (define-mode-map map mode)
+  (set! *mode-map* (append *mode-map* `((,map . ,mode)))))
+
+;; modifiers
+;; ("A" "C" "M" "H" "s" "S")
+(define *modifiers*
+  ;; Where's H?
+  '(("S"    . #b00000001)
+    ("L"    . #b00000010)
+    ("C"    . #b00000100)
+    ("M"    . #b00001000)
+    ("mod2" . #b00010000)
+    ("mod3" . #b00100000)
+    ("s"    . #b01000000)
+    ("mod5" . #b10000000)))
+
+(define (mod->int mod)
+  (assoc-ref *modifiers* mod))
+
+(define *key-press* 2)
+
+;; TODO: Support multiple modifiers! Sum their int value
+(define (kbd keys)
+  "Convert keys in our own representation.  KEYS should be a string compatible
+with the emacs format such as `C-h k'."
+  (match (let ((keys (string-split keys #\space)))
+	   (map (lambda (key) (string-split key #\-)) keys))
+    (((M1 mode) (M2 key)) `((,M1 ,mode) (,*key-press* ,(mod->int M2) ,(special->keysym key))))
+    (((M mode) (key)) `((,M ,mode) (,*key-press* 0 ,(special->keysym key))))
+    (((M1 M2 key)) `(("") (,*key-press* ,(+ (mod->int M1) (mod->int M2)) ,(special->keysym key))))
+    (((M key)) `(("") (,*key-press* ,(mod->int M) ,(special->keysym key))))
+    (((key)) `(("") (,*key-press* 0 ,(special->keysym key))))
+    (else (display "Cannot parse kdb"))))
+
+;; (kbd "C-RET C-k")
+;; (kbd "C-RET C-k")
+;; (kbd "C-RET k")
+;; (kbd "C-S-1")
+;; (kbd "C-h")
+;; (kbd "C")

share/guile/site/3.0/gri3/hooks.scm

@@ -0,0 +1,16 @@
+(define-module (gri3 hooks)
+  #:use-module (gri3 wm)
+  #:export (enter-notify-hook click-hook))
+
+(define (enter-notify-hook params)
+  "Function called each time the mouse focus changes window.
+Param is a list with: the name of the window.
+Return #f to prevent changing focus."
+  (not (string=? (car params) "no-focus")))
+
+(define (click-hook params)
+  ;; (format #t "Clicked ~A" (car params))
+  ;; (let ((root-x root-y event-x event-y state same-screen)))
+
+  ;; (not (string=? (car params) "no-focus"))
+  #t)

share/guile/site/3.0/gri3/wm.scm

@@ -0,0 +1,2 @@
+;; empty module extended by the c interface
+(define-module (gri3 wm))

src/main.c

@@ -311,12 +311,11 @@ SCM guile_refresh() {
 }
 
 static void*
-register_functions (void* data) {
+register_functions_wm(void * data) {
-  set_defaults();
   scm_c_define_gsubr ("bind-key", 2, 0, 0, &guile_register_keyboard_key);
   scm_c_define_gsubr ("change-workspace", 1, 0, 0, &guile_change_workspace);
   scm_c_define_gsubr ("refresh", 0, 0, 0, &guile_refresh);
-  scm_c_define_gsubr ("kill", 0, 0, 0, &guile_kill);
+  scm_c_define_gsubr ("kill-window", 0, 0, 0, &guile_kill);
   scm_c_define_gsubr ("split", 1, 0, 0, &guile_split);
   scm_c_define_gsubr ("focus-direction", 1, 0, 0, &guile_focus_direction);
   scm_c_define_gsubr ("layout", 1, 0, 0, &guile_layout);
@@ -326,6 +325,23 @@ register_functions (void* data) {
 
   scm_c_define_gsubr ("rename-workspace", 2, 0, 0, &guile_rename_workspace);
 
+  scm_c_export("bind-key",
+	       "bind-key",
+	       "change-workspace",
+	       "refresh",
+	       "kill-window",
+	       "split",
+	       "focus-direction",
+	       "layout",
+	       "move-to-workspace",
+	       "toggle-layout", NULL);
+}
+
+static void*
+register_functions (void* data) {
+  set_defaults();
+  scm_c_define_module ("gri3 wm", register_functions_wm, data);
+
   return NULL;
 }