~ilmu/vegur

8ac728f61816b95a2fe5e191986e8026f7362077 — ilmu 1 year, 10 months ago faac4d8
almost reached a good checkpoint with this
10 files changed, 267 insertions(+), 163 deletions(-)

M README
M bootstrap-figs/stumpwm/commands.lisp
R bootstrap-figs/stumpwm/{init.lisp => config}
A bootstrap-figs/stumpwm/internals.lisp
D bootstrap-figs/stumpwm/keyboard.lisp
D bootstrap-figs/stumpwm/keymap.lisp
A bootstrap-figs/stumpwm/keymaps.lisp
D bootstrap-figs/stumpwm/lib.lisp
M bootstrap-figs/stumpwm/swank.lisp
M config.scm
M README => README +11 -0
@@ 25,3 25,14 @@ be used to manage this material to an ever increasing extent.

Keyboards are nightmarefuel. Probably it is unnecessary for stump to do any keyboard stuff.

TODO: Add nyxt to the mix.

Programming stumpwm:
- commands like swap-windows is using (pull-window window frame) behind the scenes
- (window-frame window) gives the frame of some window
- when `pull-window` is only given a window argument then it brings it to current frame
- splitting uses `split-frame-in-dir` which has optional direction argument which is row/column.

Using the system:
- Headphones may not work until you `guix shell alsa-utils` and unmute them in `alsamixer`
- I haven't needed nonguix yet since this is a desktop machine.

M bootstrap-figs/stumpwm/commands.lisp => bootstrap-figs/stumpwm/commands.lisp +38 -9
@@ 15,13 15,9 @@ Summon windows from frame in other group as new split (so the stack abstraction)
Name windows / name frames / name groups
Serialize and load / unload for various state
API for datalisp (maybe via swank thread)


|#




;; queries : check whether layout offers motion or if split is required

;; check-window


@@ 41,16 37,49 @@ API for datalisp (maybe via swank thread)

;; motions : package queries and splits into useful actions

#|
;; all of these require sb-thread. may fail with earlier bug
;; see https://config.phundrak.com/stumpwm.html
(defcommand term (&optional program) ()
  "Invoke a terminal, possibly with a @arg{program}."
  (sb-thread:make-thread
   (lambda ()
     (run-shell-command (if program
			    (format nil "kitty ~A" program)
			    "kitty")))))

(defcommand sly-start-server (port) ((:string "Port number: "))
  "Start a slynk server for sly."
  (sb-thread:make-thread (lambda () (slynk:create-server :port (parse-integer port)
							 :dont-close t))))

(defcommand sly-stop-server (port) ((:string "Port number: "))
  "Stop current slynk server for sly."
  (sb-thread:make-thread (lambda () (slynk:stop-server (parse-integer port)))))
|#
(defcommand window-send-clipboard () ()
  (window-send-string (get-x-selection)))

;; Menu can use stump cli command runner with eval-line
(defcommand eval-selection () ()
  (eval-line (get-x-selection)))


(defcommand go-left () ()
  )
  (hsplit)
  (move-window :left))
(defcommand go-right () ()
  )
  (hsplit)
  (move-window :right))
(defcommand go-up () ()
  )
  (vsplit)
  (move-window :up))
(defcommand go-down () ()
  )

  (vsplit)
  (move-window :down))

;; such a soup of accessors, find some simple example to work from... really need repl!
;;( (frame-windows (current-group) (tile-group-current-frame (current-group)))

;; scraps


R bootstrap-figs/stumpwm/init.lisp => bootstrap-figs/stumpwm/config +23 -19
@@ 1,37 1,41 @@
(in-package :stumpwm)

(require :ttf-fonts)
(setf xft:*font-dirs* '("/run/current-system/profile/share/fonts/"))
(setf clx-truetype:+font-cache-filename+ (concat (getenv "HOME") "/.fonts/font-cache.sexp"))
(xft:cache-fonts)
(set-font (make-instance 'xft:font :family "DejaVu Sans Mono" :subfamily "Book" :size 11))
;; utils

#| REGARDING CACHE DIRECTORY
(defun show-config-pathname (filename)
  (uiop:xdg-config-home #p"stumpwm/" filename))

~/.cache is less permanent data, should be recoverable if it is destroyed.
~/.local/share is XDG_DATA_HOME by default, this data is not as transient.  |#
(defun load-config-file (file)
  (load (show-config-pathname file)))

;; utils
#| REGARDING CACHE DIRECTORY
~/.cache is less permanent data, should be recoverable if it is destroyed.
~/.local/share is XDG_DATA_HOME by default, this data is not as transient.
|#

(defun show-cache-pathname (filename)
  (uiop:xdg-data-home #p"stumpwm/" filename))

(defun show-config-pathname (filename)
  (uiop:xdg-config-home #p"stumpwm/" filename))

(defun load-config-file (file)
  (load (show-config-pathname file)))
;; init

(require :ttf-fonts)
(setf *data-dir* (show-cache-pathname ""))
(setf xft:*font-dirs* '("/run/current-system/profile/share/fonts/"))
(setf clx-truetype:+font-cache-filename+ (concat (getenv "HOME") "/.fonts/font-cache.sexp"))
(xft:cache-fonts)
(set-font (make-instance 'xft:font :family "DejaVu Sans Mono" :subfamily "Book" :size 11))


;; TODO: causal relation between keyboard options in guix system config and key-bindings in stump
;;       will be kept track of in the datalisp template logic that generates the configuration file.

(load-config-file "keyboard.lisp") ;; caps -> hyper, sort out modifiers.
(load-config-file "internals.lisp");; patches to stump core, useful for commands.
(load-config-file "commands.lisp") ;; define various commands that can be bound.
(load-config-file "swank.lisp")    ;; make it possible to open repl to running stump instance.
(load-config-file "keymap.lisp")   ;; bind commands to keys in keymaps.
(load-config-file "keymaps.lisp")  ;; bind commands to keys in keymaps to interact.

#| bind keys to *root-map* for C-t prefixed commands and *top-map* for unprefixed commands.
(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd "u") "exec kitty")
|#


;; deprecated
(defun append-to-path (path str)
  (pathname (concatenate 'string (namestring path) str)))

A bootstrap-figs/stumpwm/internals.lisp => bootstrap-figs/stumpwm/internals.lisp +97 -0
@@ 0,0 1,97 @@
#| INTERNALS

These things are basically bug reports to the stump core.

A real solution would rewrite the internals rather than hack around it like this.

|#


(defun split-frame-dir (group p dir ratio)
  "Return 2 new frames. The first one stealing P's number and window"
  (let* ((w (if (or (eq dir :left)
		    (eq dir :right))
		(ratio-or-pixel (frame-width p) ratio)
		(frame-width p))
         (h (if (or (eq dir :up)
		    (eq dir :down))
		(ratio-or-pixel (frame-height p) ratio)
		(frame-height p))
	 (x (if (eq dir :right)
		(+ (frame-x p) w)
		(frame-x p)))
	 (y (if (eq dir :down)
		(+ (frame-y p) h)
		(frame-y p)))
	 (wh (if (or (eq dir :left)
		     (eq dir :right))
		 (cons (- (frame-width p) w) h)
		 (cons w (- (frame-height p) h))))
	 (f (make-frame :number (find-free-frame-number group)
			:x x
			:y y
			:width (car wh)
			:height (cdr wh)
			:window nil)))
    ;; adjust the parameters of parent frame
    (setf (frame-width p) w
	  (frame-height p) h)
    (when (eq dir :up)
      (setf (frame-y p) (+ (frame-y p) h)))
    (when (eq dir :left)
      (setf (frame-x p) (+ (frame-x p) w)))
    ;; bureaucracy
    (if (or (eq dir :up) (eq dir :left))
	(run-hook-with-args *split-frame-hook* p f p)
	(run-hook-with-args *split-frame-hook* p p f))
    (run-hook-with-args *new-frame-hook* f)
    (values p f)))

(defun split-frame (group how &optional (ratio 1/2))
  "Split the current frame into 2 frames. Return new frame number, if
it succeeded. NIL otherwise. RATIO is a fraction of the screen to
allocate to the new split window. If ratio is an integer then the
number of pixels will be used. This can be handy to setup the
desktop when starting."
  (check-type how (member :row :column :up :down :right :left))
  (let* ((frame (tile-group-current-frame group))
         (head (frame-head group frame))
	 ;; once we've created split we need to move window provenance
	 (migrate-to-children-frames
	   (lambda (f1 f2)
	     (migrate-frame-windows group frame f1)
	     (choose-new-frame-window f2 group) ;; moves a window to new frame
	     (when (eq frame (tile-group-current-frame group))
	       (setf (tile-group-current-frame group) f1))
	     (setf (tile-group-last-frame group) f2)
	     (sync-frame-windows group f1)
	     (sync-frame-windows group f2)
	     ;; we also need to show the window we moved to the new frame
	     (when (frame-window f2)
	       (unhide-window (frame-window f2)))
	     (frame-number f2))))
    ;; backwards compat
    (when (eq how :row) (setf how :right))
    (when (eq how :column)  (setf how :down))
    ;; don't create frames smaller than the minimum size
    (when (or (and (member how '(:up :down))
		   (>= (frame-height frame) (* *min-frame-height* 2)))
	      (and (member how '(:left :right))
		   (>= (frame-width frame) (* *min-frame-width* 2))))
      (multiple-value-bind (f1 f2) (split-frame-dir group frame how ratio)
	(setf (tile-group-frame-head group head)
		 (if (atom (tile-group-frame-head group head))
		     (list f1 f2)
		     (funcall-on-node (tile-group-frame-head group head)
				      (lambda (tree)                                                         
					(substitute (list f1 f2) frame tree))                                
				      (lambda (tree)
					(unless (atom tree)
					  (find frame tree))))))
	(if (member how '(:right :down))
	    (funcall migrate-to-children-frames f1 f2)
	    (funcall migrate-to-children-frames f2 f1))))))


(defun detect-monitor-edge (group direction)
  (let ((frame (tile-group-current-frame group)))

D bootstrap-figs/stumpwm/keyboard.lisp => bootstrap-figs/stumpwm/keyboard.lisp +0 -1
@@ 1,1 0,0 @@
;; TODO: when running command `modifiers` have a key for each one of them.

D bootstrap-figs/stumpwm/keymap.lisp => bootstrap-figs/stumpwm/keymap.lisp +0 -83
@@ 1,83 0,0 @@
;; MASSIVE TODO: FIXME.


#| Keymap

*top-map*
 ^    |     use prefix or mode switch
 |    v     to move *top-map* pointer down
*root-map*
   ...
*other-maps*

The idea is to maintain DSLs for interacting.

STRATEGY
========

The top map has access to launching and rearranging via caps-lock (TODO keyboard.lisp).
There are various modes that can be switched to or accessed via prefix:
- rearrange  : commands defined in lib.lisp (TODO rename commands.lisp)
- resize     : example from stump source code with different bindings
- meta       : datalisp interop, useful for naming, exporting, importing.
- commands (default, not useful)


|#

(define-key *root-map* (kbd "u") "exec chromium")
(define-key *root-map* (kbd "z") "exec kitty")
(define-key *top-map* (kbd "M-z") "exec kitty")
(define-key *top-map* (kbd "M-x") "exec")
(define-key *top-map* (kbd "M-c") "colon")
(define-key *top-map* (kbd "M-h") "fprev")
(define-key *top-map* (kbd "M-l") "fnext")
(define-key *top-map* (kbd "M-j") "next-in-frame")
(define-key *top-map* (kbd "M-k") "prev-in-frame")

#| Modes

Insert mode    :~: default *top-map*
Command mode   :~: default *root-map*
Rearrange mode :~: mode for moving windows between (frames/stacks) and (creating/closing) (splits/frames/stacks).

Okay looks like stump already has the concept of modes.

The *root-map* can be accessed via prefix or by pushing it into *top-map* with `command-mode` command.
Mode is exited with C-g which I suppose is bound to `TODO` command in the *top-map* during `command-mode`.

This file should be a collection of commands that I bind

|#

(define-interactive-keymap (rearrange tile-group) (:on-enter #'enter-rearrange-mode
						   :on-exit #'exit-rearrange-mode
						   :abort-if #'abort-rearrange-mode-p)
  ((kbd "j") "move window up somehow")
  ...)

;; TODO: resize tile-group
;;       use different binds than in stump source.



;; structure of command-mode switch in stump

(defun rearrange-mode-start-message ()
  (message "Press q to exit rearrange-mode."))
(defun rearrange-mode-end-message ()
  (message "Exited rearrange mode"))

(defvar *rearrange-mode-start-hook* '(rearrange-mode-start-message)
  "A hook callled whenever rearrange mode is started")
(defvar *rearrange-mode-end-hook* '(rearrange-mode-end-message)
  "A hook called whenever rearrange mode is ended")

(defcommand rearrange-mode () ()
  "Rearrange mode allows you to invoke StumpWM commands, without prefix, to rearrange windows
   by opening or closing splits as necessary for the frames to contain the moving window in
   relation to all other windows. To exit command mode, type @key{q}."
  (run-hook *rearrange-mode-start-hook*)
  (push-top-map *rearrange-map*))



A bootstrap-figs/stumpwm/keymaps.lisp => bootstrap-figs/stumpwm/keymaps.lisp +84 -0
@@ 0,0 1,84 @@
#| Keymaps

The top map with caps lock (hyper) allows launching and traversing windows.
A mode switch gives access to rearranging and resizing frames / windows.
Menus are used to access niche or bulk behaviours as well as catalogue windows.
Groups are largely ignored (by user) in favour of menus, they are "window RAM".

There are various modes that can be switched to or accessed via prefix:
- rearrange  : commands for moving windows defined in commands.lisp also has resize cmds from stump src.
- meta       : datalisp interop, useful for naming, exporting, importing, launching and documenting.
- commands   : default *root-map* not useful since all useful commands will be accessible via other binds.

FIXME: NOTES REGARDING CURRENT MACHINE

H- doesn't work! FIXME!!
M- is Alt_L or Alt_R
S- is shift! remember that!
s- is windows key and caps via guix config.

TODO: List all actions I need

|#

;; ROOT MAP
(define-key *root-map* (kbd "u") "exec chromium")
(define-key *root-map* (kbd "z") "exec kitty")

;; TOP MAP - META = MODIFY
(define-key *top-map* (kbd "M-n") "gnew")
(define-key *top-map* (kbd "M-w") "pull-from-windowlist")
(define-key *top-map* (kbd "M-Up") "gnext")
(define-key *top-map* (kbd "M-Down") "gprev")
(define-key *top-map* (kbd "M-h") "move-window left")
(define-key *top-map* (kbd "M-l") "move-window right")
(define-key *top-map* (kbd "M-j") "move-window down")
(define-key *top-map* (kbd "M-k") "move-window up")

;; TOP MAP - SUPER = TRAVERSE
(define-key *top-map* (kbd "s-z") "exec kitty")
(define-key *top-map* (kbd "s-x") "exec")
(define-key *top-map* (kbd "s-c") "colon")
(define-key *top-map* (kbd "s-e") "echo-frame-windows")
(define-key *top-map* (kbd "s-b") "prev-in-frame")
(define-key *top-map* (kbd "s-n") "next-in-frame")
(define-key *top-map* (kbd "s-h") "move-focus left")
(define-key *top-map* (kbd "s-h") "move-focus left")
(define-key *top-map* (kbd "s-l") "move-focus right")
(define-key *top-map* (kbd "s-j") "move-focus down")
(define-key *top-map* (kbd "s-k") "move-focus up")

#|
;; REARRANGE MODE
(define-interactive-keymap (rearrange tile-group) (:on-enter #'enter-rearrange-mode
						   :on-exit #'exit-rearrange-mode
						   :abort-if #'abort-rearrange-mode-p)
  ((kbd "j") "move window up somehow")
  ...)
|#

;; TODO: META MODE
;;       once tala works.

#| deprecated in favour of define-interactive-keymap macro

;; structure of command-mode switch in stump

(defun rearrange-mode-start-message ()
  (message "Press q to exit rearrange-mode."))
(defun rearrange-mode-end-message ()
  (message "Exited rearrange mode"))

(defvar *rearrange-mode-start-hook* '(rearrange-mode-start-message)
  "A hook callled whenever rearrange mode is started")
(defvar *rearrange-mode-end-hook* '(rearrange-mode-end-message)
  "A hook called whenever rearrange mode is ended")

(defcommand rearrange-mode () ()
  "Rearrange mode allows you to invoke StumpWM commands, without prefix, to rearrange windows
   by opening or closing splits as necessary for the frames to contain the moving window in
   relation to all other windows. To exit command mode, type @key{q}."
  (run-hook *rearrange-mode-start-hook*)
  (push-top-map *rearrange-map*))

|#

D bootstrap-figs/stumpwm/lib.lisp => bootstrap-figs/stumpwm/lib.lisp +0 -36
@@ 1,36 0,0 @@
#| QUESTLOG

Commands I want:
----------------
Open emacs with stumpwm config file $FILE
Open emacs with sly repl into stumpwm
Chaining commands sequentially             :~: (run-commands cmd1 cmd2 ...)
Query layout left/right/top/down
Switch modes (rebind *top-map*)
Intercept unmodified keys by rebinding in *top-map*
Split frame, close split
Move window between frames and create / close splits as necessary
Move windows in frame to other group
Summon windows from frame in other group as new split (so the stack abstraction)
Name windows / name frames / name groups
Serialize and load / unload for various state
API for datalisp (maybe via swank thread)










|#



;; scraps

                     ;; args 
(defcommand dump-top-map () () ;; interactive args
  (with-open-file (s (append-to-path *data-dir* "top-map.sexp") :direction :output)))

M bootstrap-figs/stumpwm/swank.lisp => bootstrap-figs/stumpwm/swank.lisp +5 -8
@@ 1,14 1,11 @@
;; credit https://github.com/kitnil/dotfiles/blob/c247e7a3cab9b7159fad1f37fab6c0e36d0ba21b/dot_stumpwm.d/swank.lisp

(require :swank)
(require :slynk)

(swank-loader:init)

(defcommand swank (port) ((:string "Port number: "))
(defcommand slynk (port) ((:string "Port number: "))
  (sb-thread:make-thread
   (lambda ()
     (let ((swank::*loopback-interface* "127.0.0.1"))
       (swank:create-server :port (parse-integer port)
			 ;; :style swank:*communication-style*
     (let ((slynk:*loopback-interface* "127.0.0.1"))
       (slynk:create-server :port (parse-integer port)
                            :dont-close t)))
   :name "swank"))
   :name "slynk"))

M config.scm => config.scm +9 -7
@@ 13,7 13,8 @@
  (locale "en_IE.utf8")
  (timezone "Europe/London")
  (keyboard-layout
    (keyboard-layout "us,is" "altgr-intl" #:options '("grp:win_space_toggle" "caps:hyper")))
    (keyboard-layout "us,is" "altgr-intl" 
		     #:options '("grp:win_space_toggle" "caps:super" "grp_led:caps")))
  (host-name "vegur")
  (users (cons* 
                (user-account


@@ 28,11 29,12 @@
    (append
      (map specification->package ;; TODO: clean this up
        (list "git" "xclip" "kitty" "neovim" "pavucontrol" "curl"
            "emacs" "emacs-geiser" "emacs-sly" "emacs-evil" "guile"
            "emacs-evil-collection" "zathura" "zathura-pdf-mupdf"
	    "ungoogled-chromium" "setxkbmap" "font-dejavu" "tree"
            "qutebrowser" "sbcl" "stumpwm" "sbcl-stumpwm-ttf-fonts"
            "sbcl-slynk" "cl-slime-swank" "fd" "xterm" "nss-certs"))
            "emacs-geiser" "emacs-evil" "emacs-evil-collection" 
            "emacs-sly" "sbcl" "stumpwm-with-slynk" "sbcl-slynk"
            "emacs" "guile" "zathura" "zathura-pdf-mupdf" "tree"
	    "ungoogled-chromium" "setxkbmap" "font-dejavu" "fd"
            "sbcl-stumpwm-ttf-fonts" "qutebrowser" "xterm" 
	    "nyxt" "nss-certs"))

      (list `(,stumpwm "lib"))
      %base-packages))


@@ 40,7 42,7 @@
    (append
      (list (service openssh-service-type)
            (service cups-service-type)
            ;;(service alsa-service-type)
            ;; (service alsa-service-type)
            (set-xorg-configuration
              (xorg-configuration
                (keyboard-layout keyboard-layout))))