config

;; -*-lisp-*-
;;
;; Here is a sample .stumpwmrc file

(in-package :stumpwm)
(setq *debug-level* 10)
(redirect-all-output "~/.stumpwm.d/debug-output.txt")

;; change the prefix key to something else
(set-prefix-key (kbd "M-Tab"))

;; prompt the user for an interactive command. The first arg is an
;; optional initial contents.
(defcommand colon1 (&optional (initial "")) (:rest)
  (let ((cmd (read-one-line (current-screen) ": " :initial-input initial)))

    (when cmd
      (eval-command cmd t))))

;; Browse somewhere
(define-key *root-map* (kbd "b") "colon1 exec firefox http://www.")
;; Lock screen
;;(define-key *root-map* (kbd "C-l") "exec xlock")

;; Web jump (works for Google and Imdb)
(defmacro make-web-jump (name prefix)
  `(defcommand ,(intern name) (search) ((:rest ,(concatenate 'string name " search: ")))
    (substitute #\+ #\Space search)
    (run-shell-command (concatenate 'string ,prefix search))))

(make-web-jump "google" "firefox http://www.google.fr/search?q=")
(make-web-jump "imdb" "firefox http://www.imdb.com/find?q=")

;; C-t M-s is a terrble binding, but you get the idea.
(define-key *root-map* (kbd "M-s") "google")
(define-key *root-map* (kbd "i") "imdb")

;; set the font
(load-module "ttf-fonts")
(set-font "-windows-dina-medium-r-normal--12-*-96-96-c-70-iso8859-1")
(set-font (make-instance 'xft:font :family "Inconsolata" :subfamily "Regular" :size 12))

;;; Define window placement policy...

;; Clear rules
(clear-window-placement-rules)

;; This is where things I define will go until I have a better feel for StumpWM.
;;  At that point, things will be moved to places that seem more appropriate.

(define-key *root-map* (kbd "e") "exec emacsclient -c")

;; this works in the latest git version, and it behaves just like the emacs
;;  version of which-key
;;(which-key-mode)

;; allows us to connect to the wm using SLIME
(require :swank)
(echo (swank-loader:init))
(echo (swank:create-server :port 4004
                     :style swank:*communication-style*
                     :dont-close t))

(setq *mode-line-timeout* 1)
(setq *mode-line-position* :bottom)
(setq *time-modeline-string* "%a %F %H:%M:%S")
(setq *screen-mode-line-format* '("[^B%n^b] %W ^> %B %d"))
(mode-line)

;; frame/window keybindings
(defvar *window-map* (make-sparse-keymap))
(define-key *root-map* (kbd "w") '*window-map*)
(define-key *window-map* (kbd "c") "remove-split")
(define-key *window-map* (kbd "v") "hsplit")
(define-key *window-map* (kbd "s") "vsplit")

;; For some reason, this will not work. Talk to the IRC channel for help with
;;  this.
(undefine-key *root-map* (kbd "C-k"))

;; switch groups with s-[N]
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-1") "gselect 1")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-2") "gselect 2")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-3") "gselect 3")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-4") "gselect 4")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-5") "gselect 5")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-6") "gselect 6")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-7") "gselect 7")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-8") "gselect 8")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-9") "gselect 9")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-0") "gselect 0")

(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-ESC") "gselect 1")

;; move focus with s-[direction]
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-Left") "move-focus left")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-Right") "move-focus right")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-Up") "move-focus up")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-Down") "move-focus Down")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-S-Left") "exchange-direction left")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-S-Right") "exchange-direction right")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-S-Up") "exchange-direction up")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-S-Down") "exchange-direction Down")

(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-SPC") "pull-hidden-next")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "s-S-SPC") "pull-hidden-previous")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "C-s-Right") "pull-hidden-next")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "C-s-Left") "pull-hidden-previous")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "M-s-Right") "pull-hidden-next")
(stumpwm:define-key stumpwm:*top-map* (stumpwm:kbd "M-s-Left") "pull-hidden-previous")

(defcommand renumber-left () ()
  (renumber (- (window-number (current-window)) 1)))
(defcommand renumber-right () ()
  (renumber (+ (window-number (current-window)) 1)))

(define-key *top-map* (kbd "C-s-S-Left") "renumber-left")
(define-key *top-map* (kbd "M-s-S-Left") "renumber-left")
(define-key *top-map* (kbd "C-M-s-Left") "renumber-left")
(define-key *top-map* (kbd "C-s-S-Right") "renumber-right")
(define-key *top-map* (kbd "M-s-S-Right") "renumber-right")
(define-key *top-map* (kbd "C-M-s-Right") "renumber-right")

;; bindings for commonly used apps
(defvar *application-map* (make-sparse-keymap))
(define-key *root-map* (kbd "a") '*application-map*)
(define-key *application-map* (kbd "f") "exec firefox")
(define-key *application-map* (kbd "u") "exec urxvt")
(define-key *application-map* (kbd "c") "exec google-chrome-stable")
(define-key *application-map* (kbd "r") "exec riot-desktop")
(define-key *application-map* (kbd "s") "exec spotify")
(define-key *application-map* (kbd "S") "exec skypeforlinux")
(define-key *application-map* (kbd "p") "exec pavucontrol")
(define-key *application-map* (kbd "v") "exec vivaldi-stable")
;;(define-key *application-map* (kbd "g") "exec gajim")

(defvar *games-map* (make-sparse-keymap))
(define-key *application-map* (kbd "g") '*games-map*)
(define-key *games-map* (kbd "k") "exec kega-fusion")
(define-key *games-map* (kbd "f") "exec firestorm")
(define-key *games-map* (kbd "t") "exec torchlight")
;; for "Bubble Chains"
(define-key *games-map* (kbd "c") "exec chains")
(define-key *games-map* (kbd "s") "exec steam")

;; sets the focus policy so that the focus follows the mouse
(setf *mouse-focus-policy* :sloppy)

(define-key *top-map* (kbd "XF86MonBrightnessUp") "exec brightup")
(define-key *top-map* (kbd "XF86MonBrightnessDown") "exec brightdown")

;; take a screenshot
(define-key *top-map* (kbd "Print") "exec gnome-screenshot")


(ql:quickload 'cl-colors)

(defun dim-hex-color (hex-color-to-dim ammount)
  (let* ((hsv-color-to-dim
         (cl-colors:as-hsv
          (cl-colors:parse-hex-rgb hex-color-to-dim :start 1)))
         (my-hue (cl-colors:hsv-hue hsv-color-to-dim))
         (my-saturation (cl-colors:hsv-saturation hsv-color-to-dim))
         (my-value (cl-colors:hsv-value hsv-color-to-dim)))

    (cl-colors:print-hex-rgb
     (cl-colors:hsv
      my-hue
      (if (> (* my-saturation 239) (- ammount 1))
          (- my-saturation (/ ammount 239))
          my-saturation)
      (if (> (* my-value 255) (- ammount 1))
          (- my-value (/ ammount 255))
          my-value)))))

;; apply a foreground and background color to various aspects of the UI
;;
;; Note: take what's here and create a function for nicely creating colored
;;  strings
(defun apply-foreground-background (foreground background)
  (set-fg-color foreground)
  (set-fg-color background)
  (set-focus-color foreground)
  (setq *mode-line-foreground-color* foreground)
  (setq *mode-line-background-color* background)
  (set-win-bg-color foreground)
  (set-focus-color foreground)
  (set-unfocus-color background)
  (setq *bar-med-color* (concat "^(:fg \"" (dim-hex-color foreground 10) "\")"))
  (setq *bar-hi-color* (concat "^(:fg \"" (dim-hex-color foreground 5) "\")"))
  (setq *bar-crit-color* (concat "^(:fg \"" foreground "\")"))
  (mode-line)
  (mode-line))

(ql:quickload 'inferior-shell)
(defun emacs-repl-send-string (string-to-send)
  (handler-case
      (string-trim "\\\""
                   (string-right-trim (string #\NewLine)
                                      (inferior-shell:run/s
                                       `(emacsclient --eval ,string-to-send))))

    (UIOP/RUN-PROGRAM:subprocess-error (spe)
      ;;(echo "Failed to connect to emacs-daemon. Is it started?")
      (cerror "Failed to connect to send ~s emacs-daemon. Is it running?" string-to-send))))
;;(car (split-string (inferior-shell:run/s `(emacsclient --eval ,string)) "\\\""))

(defun apply-emacs-colors ()
  (handler-case
  (apply-foreground-background
   (emacs-repl-send-string "(face-foreground 'default)")
   (emacs-repl-send-string "(face-background 'default)"))
    (simple-error (se) (echo "Failed to apply emacs colors."))))

(defun apply-emacs-font ()
  (let ((font-to-apply (emacs-repl-send-string
                        "(car elephant454initel-current-font)"))
        (size-to-apply (emacs-repl-send-string
                         "(+ elephant454initel-font-scale (cdr elephant454initel-current-font))")))

    (handler-case
         (set-font (make-instance 'xft:font
                                  :family font-to-apply
                                  :subfamily "Regular"
                                  :size (parse-integer size-to-apply)))

      (simple-error (se)
        (set-font (concat "-*-" font-to-apply "-medium-r-*--"
                          size-to-apply "-*-*-*-*-*-*-*"))))))

(apply-emacs-colors)

(load-module "battery-portable")

;;;; This is where all the gaps stuff goes. This should really be its own file,
;;;;  and ideally it would be it's own module, but later.
(defvar *useless-gaps-size* 10)
(defvar *useless-gaps-on* t)

;; Redefined - with `if`s for *useless-gaps-on*
(defun maximize-window (win)
  "Maximize the window."
  (multiple-value-bind (x y wx wy width height border stick)
      (geometry-hints win)

    (if *useless-gaps-on*
        (setf width (- width (* 2 *useless-gaps-size*))
              height (- height (* 2 *useless-gaps-size*))
              x (+ x *useless-gaps-size*)
              y (+ y *useless-gaps-size*)))

    (dformat 4 "maximize window ~a x: ~d y: ~d width: ~d height: ~d border: ~d stick: ~s~%" win x y width height border stick)
    ;; This is the only place a window's geometry should change
    (set-window-geometry win :x wx :y wy :width width :height height :border-width 0)
    (xlib:with-state ((window-parent win))
      ;; FIXME: updating the border doesn't need to be run everytime
      ;; the window is maximized, but only when the border style or
      ;; window type changes. The overhead is probably minimal,
      ;; though.
      (setf (xlib:drawable-x (window-parent win)) x
            (xlib:drawable-y (window-parent win)) y
            (xlib:drawable-border-width (window-parent win)) border)
      ;; the parent window should stick to the size of the window
      ;; unless it isn't being maximized to fill the frame.
      (if (or stick
              (find *window-border-style* '(:tight :none)))
          (setf (xlib:drawable-width (window-parent win)) (window-width win)
                (xlib:drawable-height (window-parent win)) (window-height win))
          (let ((frame (window-frame win)))
            (setf (xlib:drawable-width (window-parent win)) (- (frame-width frame)
                                                               (* 2 (xlib:drawable-border-width (window-parent win)))
                                                               (if *useless-gaps-on* (* 2 *useless-gaps-size*) 0))
                  (xlib:drawable-height (window-parent win)) (- (frame-display-height (window-group win) frame)
                                                                (* 2 (xlib:drawable-border-width (window-parent win)))
                                                                (if *useless-gaps-on* (* 2 *useless-gaps-size*) 0)))))
      ;; update the "extents"
      (xlib:change-property (window-xwin win) :_NET_FRAME_EXTENTS
                            (list wx wy
                                  (- (xlib:drawable-width (window-parent win)) width wx)
                                  (- (xlib:drawable-height (window-parent win)) height wy))
                            :cardinal 32))))

(defun reset-all-windows ()
  "Reset the size for all tiled windows"
  (let ((windows (mapcan (lambda (g)
                           (mapcar (lambda (w) w) (sort-windows g)))
                         (sort-groups (current-screen)))))
    (mapcar (lambda (w)
              (if (string= (class-name (class-of w)) "TILE-WINDOW")
                  (maximize-window w))) windows)))

(defcommand gaps () ()
            "Toggle the padding of tiled windows"
            (setf *useless-gaps-on* (null *useless-gaps-on*))

            ;; Following is pseudo code to use hooks
            ;; to do something like change border colors or size
            ;; (if *useless-gaps-on*
            ;;     (run-hook 'frame-gap-on)
            ;;     (run-hook 'frame-gap-off))
            (reset-all-windows))

;; look into (load-module "ttf-fonts"). This whole page is interesting:
;;  https://github.com/ivoarch/.dot-org-files/blob/master/stumpwm.org

;; this prevents weird thick borders from forming around the top and bottom of
;;  emacs
(setq *ignore-wm-inc-hints* t)
(setq *window-border-style* :THIN)


;; tried to do a remote thing? This should be run inside of Emacs.
;;(slime-connect "localhost" "4004" "utf-8-unix" (slime-interactive-eval "(stumpwm:apply-emacs-colors)"))

;; this successfully sends a command from emacs lisp to stumpwm
;;(slime-connect "localhost" "4004")
;;(slime-repl-send-string "(stumpwm:echo \"hi\")")

;; some external applications to start up
(run-shell-command "redshift")
(run-shell-command "compton --config /home/matthew/.comptonrc")
(run-shell-command "ssh-agent /usr/local/bin/stumpwm")
(run-shell-command "/home/matthew/.fehbg")

(run-shell-command "setxkbmap -option compose:caps")
(run-shell-command "setxkbmap -option grp:shifts_toggle")
(run-shell-command "setxkbmap us,gr")
(run-shell-command "numlockx")