Big update

config

@@ -1,5 +1,16 @@
 ;;; -*-  mode: lisp; -*-
 (in-package :stumpwm)
+;;; Setup Modules and Quicklisp
+;; path to modules
+;; git clone git@github.com:stumpwm/stumpwm-contrib.git ~/.config/stumpwm/modules
+(init-load-path #p"~/.config/stumpwm/modules/")
+(let ((quicklisp-init (merge-pathnames ".cache/quicklisp/setup.lisp"
+                                       (user-homedir-pathname))))
+  (when (probe-file quicklisp-init)
+    (load quicklisp-init)))
+
+;; (setq *debug-level* 5)
+;; (redirect-all-output (data-dir-file "debug-output" "txt"))
 
 ;;; Helpers
 (defun tr-define-key (key command)
@@ -10,7 +21,7 @@
   "Return t, if FILE is available for reading."
   (handler-case
       (with-open-file (f file)
-        (read-line f))
+                      (read-line f))
     (stream-error () nil)))
 
 (defun executable-p (name)
@@ -19,11 +30,86 @@
                                 (run-shell-command (concat "which " name) t))))
     (unless (string-equal "" which-out) which-out)))
 
+(defun window-menu-format (w)
+  (list (format-expand *window-formatters* *window-format* w) w))
+
+(defun window-from-menu (windows)
+  (when windows
+    (second (select-from-menu
+             (group-screen (window-group (car windows)))
+             (mapcar 'window-menu-format windows)
+             "Select Window: "))))
+
+(defun windows-in-group (group)
+  (group-windows (find group (the list (screen-groups (current-screen)))
+                       :key 'group-name :test 'equal)))
+
+(defun floatingp (window)
+  "Return T if WINDOW is floating and NIL otherwise"
+  (typep window 'stumpwm::float-window))
+
+(defun always-on-top-off (window) ()
+       "Stop the given WINDOW from always being on top of other windows"
+       (let ((ontop-wins (group-on-top-windows (current-group))))
+         (setf (group-on-top-windows (current-group))
+               (remove window ontop-wins))))
+
+(defun always-on-top-on (window) ()
+       "Set the given WINDOW to always be on top of other windows"
+       (let ((w window)
+             (windows (the list (group-on-top-windows (current-group)))))
+         (when w
+           (unless (find w windows)
+             (push window (group-on-top-windows (current-group)))))))
+
+(defmacro with-on-top (win &body body)
+  "Make sure WIN is on the top level while the body is running and
+restore it's always-on-top state afterwords"
+  (let ((cw (gensym))
+        (ontop (gensym)))
+    `(let* ((,cw ,win)
+            (,ontop (find ,cw (group-on-top-windows (current-group)))))
+       (unwind-protect
+           (progn (unless ,ontop (always-on-top-on ,cw))
+                  ,@body))
+       (unless ,ontop (always-on-top-off ,cw)))))
+(defun slop-get-pos ()
+  (mapcar #'parse-integer (ppcre:split "[^0-9]" (run-shell-command
+                                                 "slop -f \"%x %y %w %h\"" t))))
+
+(defun slop ()
+  "Slop the current window or just float if slop cli not present."
+  (when (executable-p "slop")
+    (let ((win    (current-window))
+          (group  (current-group))
+          (pos    (slop-get-pos)))
+      (stumpwm::float-window win group)
+      (stumpwm::float-window-move-resize win
+                                         :x (nth 0 pos)
+                                         :y (nth 1 pos)
+                                         :width (nth 2 pos)
+                                         :height (nth 3 pos))
+      (always-on-top-on win))))
+
+;;; Moving the mouse for me
+;; Used for warping the cursor
+(load-module "beckon")
+(defmacro with-focus-lost (&body body)
+  "Make sure WIN is on the top level while the body is running and
+restore it's always-on-top state afterwords"
+  `(progn (banish)
+          ,@body
+          (when (current-window)
+            (beckon:beckon))))
+
+(defcommand remove-lose-focus () ()
+  "Remove the window without feaking out because of :sloppy *mouse-focus-policy*"
+  (with-focus-lost (remove-split)))
+
+(defcommand fullscreen-and-raise () ()
+  "Fullscreen window and make sure it's on top of all other windows"
+  (with-on-top (stumpwm:current-window) (fullscreen)))
 
-;; path to modules
-;; git clone git@github.com:stumpwm/stumpwm-contrib.git ~/.config/stumpwm/modules
-(init-load-path #p"~/.config/stumpwm/modules/")
-(load "~/.cache/quicklisp/setup.lisp")
 ;;; Theme
 (setf *colors*
       '("#000000"   ;black
@@ -35,12 +121,8 @@
         "#53cdbd"   ;cyan
         "#ffffff")) ;white
 
-;; (setf *default-bg-color* "#e699cc")
-
 (update-color-map (current-screen))
 
-(setf *window-format* "%m%s%50t")
-
 ;;; Font
 (ql:quickload :clx-truetype)
 
@@ -61,6 +143,7 @@
                                 :antialias t)))))
 
 ;;; Basic Settings
+(setf *window-format* "%m%s%50t")
 (setf *mode-line-background-color* (car *colors*)
       *mode-line-foreground-color* (car (last *colors*))
       *mode-line-timeout* 1)
@@ -121,6 +204,7 @@
 
 ;; Window Movement
 (dyn-blacklist-command "move-window")
+(dyn-blacklist-command "remove-lose-focus")
 (define-key *top-map* (kbd "s-H") "move-window left")
 (define-key *top-map* (kbd "s-J") "move-window down")
 (define-key *top-map* (kbd "s-K") "move-window up")
@@ -139,18 +223,7 @@
 (when *initializing*
   (defconstant backlightfile "/sys/class/backlight/intel_backlight/brightness"))
 
-;; Xbacklight broak so I made this
+(let ((bdown   "exec xbacklight -dec 10")
-(defcommand brighten (val) ((:number "Change brightness by: "))
-  (with-open-file (fp backlightfile
-                      :if-exists :overwrite
-                      :direction :io)
-                      (write-sequence (write-to-string (+ (parse-integer (read-line fp nil)) val))
-                                      fp)))
-
-(let (;; If xbacklight doesn't work use this (requires special file permissions)
-      ;; (bdown "brighten -1000")
-      ;; (bup   "brighten  1000")
-      (bdown   "exec xbacklight -dec 10")
       (bup     "exec xbacklight -inc 10")
       (m *top-map*))
   (define-key m (kbd "s-C-s")                 bdown)
@@ -167,20 +240,11 @@
 (define-key *root-map* (kbd "C-c") "term")
 (define-key *root-map* (kbd "y") "eval (term \"cm\")")
 (define-key *root-map* (kbd "w") "exec ducksearch")
-
 (define-key *root-map* (kbd "b") "pull-from-windowlist")
-
-
-;; Hide the current window but don't freak out if the current focus
-;; policy is :sloppy.
-(defcommand remove-lose-focus () ()
-  (let ((*mouse-focus-policy* :ignore))
-    (remove-split)))
-
-;; (define-key *root-map* (kbd "r") "remove")
-(define-key *root-map* (kbd "r") "remove-lose-focus")
 (define-key *root-map* (kbd "R") "iresize")
-(define-key *root-map* (kbd "f") "fullscreen")
+(define-key *root-map* (kbd "B") "beckon")
+(define-key *root-map* (kbd "r") "remove-lose-focus")
+(define-key *root-map* (kbd "f") "fullscreen-and-raise")
 (define-key *root-map* (kbd "Q") "quit-confirm")
 
 (define-key *root-map* (kbd "SPC") "exec cabl -c")
@@ -192,10 +256,10 @@
 (grename "main")
 (gnewbg ".trash") ; hidden group
 (gnewbg "distractions") ; for discord and stuff
+(gnew-dynamic "dy")
 
 ;; Don't jump between groups when switching apps
 (setf *run-or-raise-all-groups* nil)
-(define-key *groups-map* (kbd "=") "change-default-split-ratio 1/2")
 (define-key *groups-map* (kbd "l") "change-default-layout")
 (define-key *groups-map* (kbd "d") "gnew-dynamic")
 (define-key *groups-map* (kbd "s") "gselect")
@@ -204,20 +268,6 @@
 (define-key *groups-map* (kbd "b") "global-pull-windowlist")
 
 ;;;; Hide and Show Windows
-(defun window-menu-format (w)
-  (list (format-expand *window-formatters* *window-format* w) w))
-
-(defun window-from-menu (windows)
-  (when windows
-    (second (select-from-menu
-             (group-screen (window-group (car windows)))
-             (mapcar 'window-menu-format windows)
-             "Select Window: "))))
-
-(defun windows-in-group (group)
-  (group-windows (find group (the list (screen-groups (current-screen)))
-                       :key 'group-name :test 'equal)))
-
 (defcommand pull-from-trash () ()
   (let* ((windows (windows-in-group ".trash"))
          (window  (window-from-menu windows)))
@@ -233,82 +283,58 @@
 
 
 ;;; Floating Windows
-;;;; Part of this was taken from https://github.com/lepisma/cfg
-(defun floatingp (window)
-  "Return T if WINDOW is floating and NIL otherwise"
-  (typep window 'stumpwm::float-window))
-
-(defun always-on-top-off (window) ()
-  "stop the given WINDOW from always being on top of other windows"
-  (let ((ontop-wins (group-on-top-windows (current-group))))
-    (setf (group-on-top-windows (current-group))
-          (remove window ontop-wins))))
-
-(defun always-on-top-on (window) ()
-  "set the given WINDOW to always be on top of other windows"
-  (let ((w window)
-        (windows (the list (group-on-top-windows (current-group)))))
-    (when w
-      (unless (find w windows)
-        (push window (group-on-top-windows (current-group)))))))
-
-
-(defun slop-get-pos ()
-  (mapcar #'parse-integer (ppcre:split "[^0-9]" (run-shell-command
-                                                 "slop -f \"%x %y %w %h\"" t))))
-
-(defun slop ()
-  "Slop the current window or just float if slop cli not present."
-  (when (executable-p "slop")
-    (let ((win    (current-window))
-          (group  (current-group))
-          (pos    (slop-get-pos)))
-      (stumpwm::float-window win group)
-      (stumpwm::float-window-move-resize win
-                                         :x (nth 0 pos)
-                                         :y (nth 1 pos)
-                                         :width (nth 2 pos)
-                                         :height (nth 3 pos))
-      (always-on-top-on win))))
-
 (defcommand toggle-slop-this () ()
   (let ((win    (current-window))
         (group  (current-group)))
     (cond
-      ((floatingp win)
+     ((floatingp win)
-       (always-on-top-off win)
+      (always-on-top-off win)
-       (stumpwm::unfloat-window win group))
+      (stumpwm::unfloat-window win group))
-      (t (slop)))))
+     (t (slop)))))
 
 (tr-define-key "z" "toggle-slop-this")
 
 ;;; Splits
 (defcommand hsplit-and-focus () ()
   "create a new frame on the right and focus it."
-  (hsplit)
+  (with-focus-lost
-  (move-focus :right))
+   (hsplit)
+   (move-focus :right)))
 
 (defcommand vsplit-and-focus () ()
   "create a new frame below and focus it."
-  (vsplit)
+  (with-focus-lost
-  (move-focus :down))
+   (vsplit)
+   (move-focus :down)))
 (define-key *root-map* (kbd "v") "hsplit-and-focus")
 (define-key *root-map* (kbd "s") "vsplit-and-focus")
+
+;; Extra mappings for dynamic windows
+(define-minor-mode my/tile-mode () ()
+  (:interactive t)
+  (:scope :dynamic-group)
+  (:top-map '(("s-v" . "exchange-with-master")
+              ("s-=" . "change-default-split-ratio 1/2")))
+  (:lighter-make-clickable nil)
+  (:lighter "MY/TILE"))
+;; (my/tile-mode)
 (loop :for i :in '("hsplit-and-focus"
-                 "vsplit-and-focus")
+                   "vsplit-and-focus")
       :do (dyn-blacklist-command i))
 
 ;;; Mode-Line
 (load-module "battery-portable")
 
-;; Get Fit
+;;;; Get Fit
 (declaim (type fixnum *reps*))
 (defvar *reps* 0
   "Variable for keeping track of reps")
+
 (defcommand add-reps (reps) ((:number "Enter reps: "))
   (declare (type fixnum reps))
   (when reps
     (setq *reps* (+ *reps* reps))))
+
 (defcommand reset-reps () ()
   (setq *reps* 0))
 
@@ -319,6 +345,7 @@
     m))
 (define-key *root-map* (kbd "ESC") '*gym-map*)
 
+;;;; Actual Modeline
 (setf *time-modeline-string* "%a, %b %d %I:%M%p")
 (setf *screen-mode-line-format*
       (list
@@ -336,8 +363,8 @@
 
 (defun enable-mode-line-everywhere ()
   (loop for screen in *screen-list* do
-    (loop for head in (screen-heads screen) do
+        (loop for head in (screen-heads screen) do
-	    (enable-mode-line screen head t))))
+              (enable-mode-line screen head t))))
 (enable-mode-line-everywhere)
 ;; turn on/off the mode line for the current head only.
 (define-key *top-map* (kbd "s-B") "mode-line")
@@ -346,42 +373,47 @@
 (load-module "swm-gaps")
 (setf swm-gaps:*inner-gaps-size* 13
       swm-gaps:*outer-gaps-size* 7
-      swm-gaps:*head-gaps-size* 7)
+      swm-gaps:*head-gaps-size* 0)
 (when *initializing*
   (swm-gaps:toggle-gaps))
 (define-key *groups-map* (kbd "g") "toggle-gaps")
 
 ;;; Remaps
 (define-remapped-keys
-    '(("(discord|Element|Google-chrome)"
+  '(("(acme)"
-       ("C-a"   . "Home")
+     ("C-b"   . "Left")
-       ("C-e"   . "End")
+     ("C-n"   . "Down")
-       ("C-E"   . "C-e")
+     ("C-p"   . "Up")
-       ("C-n"   . "Down")
+     ("C-d"   . ("Right" "C-h")))
-       ("C-p"   . "Up")
+    ("(discord|Element|Google-chrome)"
-       ("C-f"   . "Right")
+     ("C-a"   . "Home")
-       ("C-b"   . "Left")
+     ("C-e"   . "End")
-       ("C-N"   . "S-Down")
+     ("C-E"   . "C-e")
-       ("C-P"   . "S-Up")
+     ("C-n"   . "Down")
-       ("C-F"   . "S-Right")
+     ("C-p"   . "Up")
-       ("C-B"   . "S-Left")
+     ("C-f"   . "Right")
-       ("C-v"   . "Next")
+     ("C-b"   . "Left")
-       ("M-v"   . "Prior")
+     ("C-N"   . "S-Down")
-       ("M-w"   . "C-c")
+     ("C-P"   . "S-Up")
-       ("C-w"   . ("C-S-Left" "C-x"))
+     ("C-F"   . "S-Right")
-       ("C-y"   . "C-v")
+     ("C-B"   . "S-Left")
-       ("M-<"   . "Home")
+     ("C-v"   . "Next")
-       ("M->"   . "End")
+     ("M-v"   . "Prior")
-       ("C-M-b" . "M-Left")
+     ("M-w"   . "C-c")
-       ("C-M-f" . "M-Right")
+     ("C-w"   . ("C-S-Left" "C-x"))
-       ("M-f"   . "C-Right")
+     ("C-y"   . "C-v")
-       ("M-b"   . "C-Left")
+     ("M-<"   . "Home")
-       ("C-s"   . "C-f")
+     ("M->"   . "End")
-       ("C-j"   . "C-k")
+     ("C-M-b" . "M-Left")
-       ("C-/"   . "C-z")
+     ("C-M-f" . "M-Right")
-       ("C-k"   . ("C-S-End" "C-x"))
+     ("M-f"   . "C-Right")
-       ("C-d"   . "Delete")
+     ("M-b"   . "C-Left")
-       ("M-d"   . "C-Delete"))))
+     ("C-s"   . "C-f")
+     ("C-j"   . "C-k")
+     ("C-/"   . "C-z")
+     ("C-k"   . ("C-S-End" "C-x"))
+     ("C-d"   . "Delete")
+     ("M-d"   . "C-Delete"))))
 
 ;;; Undo And Redo Functionality
 (load-module "winner-mode")
@@ -395,7 +427,7 @@
 (defcommand emacs () () ; override default emacs command
   "Start emacs if emacsclient is not running and focus emacs if it is
 running in the current group"
-  (run-or-raise "emacsclient -c -a 'emacs'" '(:class "Emacs")))
+  (run-or-raise "oemacsclient -c -a 'emacs'" '(:class "Emacs")))
 ;; Treat emacs splits like Xorg windows
 (defun is-emacs-p (win)
   "nil if the WIN"
@@ -463,28 +495,38 @@ necessary programs for recording a new YouTube video"
   (setup-recording-environment "recording"))
 
 
-;;; Moving the mouse for me
-;; Used for warping the cursor
-(load-module "beckon")
-(define-key *root-map* (kbd "B") "beckon")
-
 ;;; Window focusing
+(defun switched-emacs-window (dir)
+  (declare  (type Keyword dir)
+            (optimize (speed 3) (safety 1)))
+
+  (if (is-emacs-p (current-window))
+      ;; There is not emacs window in that direction
+      (not
+       (length=
+        (emacs-winmove (string-downcase (string dir)))
+        1))
+    nil))
+
+(defun maybe-beckon ()
+  (if (current-window)
+      (beckon:beckon)
+    nil))
+
 (defun better-move-focus (ogdir)
   "Similar to move-focus but also treats emacs windows as Xorg windows"
-  (declare (type (member :up :down :left :right) ogdir))
+  (declare (type (member :up :down :left :right) ogdir)
-  (flet ((mv () (progn (move-focus ogdir)
+           (optimize (speed 3) (safety 3)))
 
-                       ;; Warp cursor when changing focus
+  (let ((cw  (current-window)))
-                       (when (current-window)
+    (cond
-                         (beckon:beckon))
+     ((not cw) (progn (move-focus ogdir)
-                       )))
+                      (maybe-beckon)))
-    (if (is-emacs-p (current-window))
+     ((switched-emacs-window ogdir))
-        (when ;; There is not emacs window in that direction
+     ;; If fullscreen don't change focus
-            (length= (emacs-winmove (string-downcase (string ogdir)))
+     ((stumpwm:window-fullscreen cw))
-                     1)
+     (t (progn (move-focus ogdir)
-          (mv))
+               (maybe-beckon))))))
-        (mv)))
-  )
 
 
 (defcommand my-mv (dir) ((:direction "Enter direction: "))
@@ -507,8 +549,8 @@ necessary programs for recording a new YouTube video"
          :dont-close t
          :port port))
     (error (c)
-      (format *error-output* "Error starting slynk: ~a~%" c)
+           (format *error-output* "Error starting slynk: ~a~%" c)
-      )))
+           )))
 
 (defcommand restart-slynk () ()
   "Restart Slynk and reload source.
@@ -518,7 +560,7 @@ This is needed if Sly updates while StumpWM is running"
 
 (defcommand stop-slynk () ()
   "Restart Slynk and reload source.
-This is needed if Sly updates while StumpWM is running"
+  This is needed if Sly updates while StumpWM is running"
   (slynk:stop-server *slynk-port*))
 
 (defcommand connect-to-sly () ()
@@ -526,3 +568,9 @@ This is needed if Sly updates while StumpWM is running"
     (start-slynk))
   (exec-el (sly-connect "localhost" *slynk-port*))
   (emacs))
+
+(define-stumpwm-type :dunstctl (input prompt)
+  (completing-read (current-screen) prompt '("context" "action" "close" "history")))
+
+(defcommand dunst () ()
+  (run-shell-command "dunstctl context"))