init.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (find-package "EM-CUSTOM")
    (defpackage :em-custom
      (:use :cl :stumpwm))))

(in-package :em-custom)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *client-location*
    (let ((host (uiop:hostname)))
      (cond ((equal host "em-desktop")
             :em-desktop)
            (t
             nil))))
  (when (eq *client-location* :em-desktop)
    (unless (find-package "STUMPWM-DBUS")
      (ql:quickload "log4cl")
      (ql:quickload "stumpwm-dbus"))))

(defmacro select-group-or-create ((name &key (float nil)) &body body)
  (let ((name-sym (gensym "NAME-"))
        (group-sym (gensym "GROUP-")))
    `(let* ((,name-sym ,name)
            (,group-sym (find ,name-sym (screen-groups (current-screen)) :key #'group-name :test #'equal)))
       (if ,group-sym
           (gselect ,group-sym)
           (progn
             ,(if float
                  `(gnew-float ,name-sym)
                  `(gnew ,name-sym))
             (progn
               ,@body))))))

;;;
;;;  Volume control
;;;

(defun update-mixer (channel amount)
  (message "~a ~a~%    ~a"
           channel (or amount "toggled")
           (run-shell-command
            (format nil "amixer sset ~a ~:[toggle~;~:*~a~] | grep '^[ ]*Mono'" channel amount) t)))

(defcommand update-volume (channel amount)
    ((:string channel)
     (:number amount))
  "Updates volume of channel CHANNEL by AMOUNT."
  (unless (member channel '("PCM" "Master" "Headphone") :test #'equal)
    (error "Illegal channel name: ~s" channel))
  (update-mixer channel (if (minusp amount)
                            (format nil "~a-" (abs amount))
                            (format nil "~a+" amount))))

(defvar *audio-map* (let ((m (stumpwm::copy-kmap *input-map*)))
                      (define-key m (kbd "Up") (lambda (map key)
                                                 (declare (ignore map key))
                                                 (update-volume "Master" 2)))
                      (define-key m (kbd "Down") (lambda (map key)
                                                   (declare (ignore map key))
                                                   (update-volume "Master" -2)))
                      m))

(defcommand dynamic-update-volume () ()
  "Updates the volume interactively. Use the keys UP and DOWN do control volume, or type an absolute value."
  (let ((*input-map* *audio-map*))
    (message "Result: ~s" (read-one-line (current-screen) "Volume: "))))

;;;
;;;  Mode line
;;;

(defun format-date ()
  (multiple-value-bind (sec min hour date month year)
      (decode-universal-time (get-universal-time))
    (declare (ignore sec))
    (format nil "~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d" year month date hour min)))

(defun activate-mode-line ()
  (setf *screen-mode-line-format*  (append '("[^B%n^b] %W | " (:eval (format-date)))
                                           (if (eq *client-location* :em-desktop)
                                               '(" | "
                                                 (:eval (format nil "~a" (stumpwm-dbus:num-active-notifications))))
                                               nil)))
  (setf *mode-line-position* :bottom)
  (dolist (m (screen-heads (current-screen)))
    (unless (stumpwm::head-mode-line m)
      (toggle-mode-line (current-screen) m))))

(activate-mode-line)

;;;
;;;  Maximise window
;;;

(defun update-max (win)
  (let* ((head (window-head win))
         (modeline (stumpwm::head-mode-line head))
         (x (frame-x head))
         (y (+ (frame-y head)
               (if (and modeline
                        (eq (stumpwm::mode-line-position modeline) :top))
                   (stumpwm::mode-line-height modeline)
                   0)))
         (width (- (frame-width head) (* stumpwm::*float-window-border* 2) 2))
         (height (- (frame-height head)
                    stumpwm::*float-window-title-height*
                    stumpwm::*float-window-border*
                    1
                    (if modeline
                        (stumpwm::mode-line-height modeline)
                        0))))
    (if (and (= (window-x win) x)
             (= (window-y win) y)
             (= (window-width win) width)
             (= (window-height win) height))
        ;; The window is already maximised
        (let ((last-x (stumpwm::float-window-last-x win))
              (last-y (stumpwm::float-window-last-y win))
              (last-width (stumpwm::float-window-last-width win))
              (last-height (stumpwm::float-window-last-height win)))
          (unless (and (= x last-x)
                       (= y last-y)
                       (= width last-width)
                       (= height last-height))
            (stumpwm::float-window-move-resize win :x last-x :y last-y :width last-width :height last-height)))
        ;; ELSE: Set the new maximised dimensions
        (stumpwm::float-window-move-resize win :x x :y y :width width :height height))))

(defcommand fullscreen-float () ()
  "Sets the dimensions of the current window to fill the entire screen"
  (when (typep (current-group) 'stumpwm::float-group)
    (let ((win (current-window)))
      (when win
        (update-max win)))))

;;;
;;;  Some windows should be floating
;;;

#+nil
(defun push-event (fn)
  (sb-thread:with-mutex ((stumpwm::request-channel-lock stumpwm::*request-channel*))
    (push fn (stumpwm::request-channel-queue stumpwm::*request-channel*)))
  (let ((out (stumpwm::request-channel-out stumpwm::*request-channel*)))
    (write-byte 0 out)
    (finish-output out)))

(defvar *out* (make-broadcast-stream))

(defun emulator-title-p (name)
  (or (alexandria:starts-with-subseq "Android Emulator" name)
      (equal name "Emulator")
      (equal name "Extended controls")))

(defun emulator-p (win)
  (and (equal (group-name (window-group win)) "Android")
       (emulator-title-p (window-title win))))

(defun handle-new-window-created (win)
  (format *out* "Window created: ~s~%" win)
  (when (or (and (member (window-class win) '("jetbrains-idea" "jetbrains-studio") :test #'equal)
                 (eq (window-type win) :dialog))
            (equal (window-class win) "XTerm")
            (emulator-p win))
    (push-event (lambda ()
                  (stumpwm::float-window win (window-group win))))))

(add-hook *new-window-hook* 'handle-new-window-created)

(defcommand android-float () ()
  (loop
    for win in (group-windows (current-group))
    do (format *out* "Checking window: ~s, type: ~s~%" win (type-of win))
    when (and (typep win 'stumpwm::tile-window)
              (emulator-title-p (window-title win)))
      do (progn
           (format *out* "    Floatifying window: ~s~%" win)
           (stumpwm::float-window win (current-group)))))

#+nil
(defmethod stumpwm:group-add-window :around ((group stumpwm::tile-group) win &key)
  (when (and (not (typep win 'stumpwm::float-window))
             (emulator-p win))
    (change-class win 'stumpwm::float-window))
  (call-next-method))

;;;
;;;  Workaround for WM_TAKE_FOCUS issue in IDEA
;;;

#+nil
(defun handle-focus-window-update (win cw)
  (declare (ignore cw))
  (when (and (member :WM_TAKE_FOCUS (xlib:wm-protocols (window-xwin win)) :test #'eq)
             (equal (window-class win) "jetbrains-idea")
             (eq (window-type win) :normal))
    (stumpwm::send-client-message win :WM_PROTOCOLS
                                  (xlib:intern-atom *display* :WM_TAKE_FOCUS)
                                  0)))

;;(add-hook stumpwm:*focus-window-hook* 'handle-focus-window-update)

;;;
;;;  Helper commands
;;;

;;; Browser

(defcommand chrome-unstable () ()
  "Start Chrome unless it's already running"
  (run-or-raise "google-chrome-unstable" '(:class "Google-chrome-unstable")))

(defcommand chrome-unstable-new () ()
  "Open a new Chrome window, regardless whether a window exists or not."
  (run-shell-command "google-chrome-unstable"))

;;; Screen lock

(defcommand lock-screen () ()
  "Lock the screen"
  (run-or-raise "xscreensaver-command -lock" '(:instance "xscreensaver")))

;;; Swank

(defcommand enable-swank () ()
  "Temporarily enables the swank server."
  (swank:create-server :port 9898))

;;; Android Studio

(defcommand android-studio () ()
  "Start Android Studio in its own group"
  (select-group-or-create ("Android Studio" :float t)
    (run-shell-command "~/src/android-studio/bin/studio.sh" nil)))

(defun find-idea-command ()
  (let ((dirlist (directory #p"~/src/idea*/")))
    (when (= (length dirlist) 1)
      (namestring (merge-pathnames #p"bin/idea.sh" (car dirlist))))))

(defcommand idea () ()
  "Start IntelliJ IDEA"
  (let ((group (find "IDEA" (screen-groups (current-screen)) :key #'group-name :test #'equal)))
    (when group
      (let ((idea-command (find-idea-command)))
        (when idea-command
          (gselect group)
          (run-or-raise idea-command '(:class "jetbrains-idea")))))))

;;; Spotify

(defcommand music-player () ()
  "Start the music player in its own group"
  (select-group-or-create ("Spotify")
    (run-shell-command "spotify" nil)))

;;; Media control

(defvar *media-map* (make-sparse-keymap))

(define-key *root-map* (kbd "m") '*media-map*)

(define-key *media-map* (kbd "n") "media-player-next")
(define-key *media-map* (kbd "p") "media-player-previous")
(define-key *media-map* (kbd "m") "media-player-play-pause")

;;; Dbus notifications

(define-key *root-map* (kbd "C-j") "open-notifications")

;;; Window navigation

(define-key *top-map* (kbd "H-q") "move-focus left")
(define-key *top-map* (kbd "H-w") "move-focus right")
(define-key *top-map* (kbd "H-a") "move-focus up")
(define-key *top-map* (kbd "H-z") "move-focus down")
(define-key *top-map* (kbd "H-M-q") "move-window left")
(define-key *top-map* (kbd "H-M-w") "move-window right")
(define-key *top-map* (kbd "H-M-a") "move-window up")
(define-key *top-map* (kbd "H-M-z") "move-window down")

;;; Initial screen layout

(defmacro define-frame-preferences (&body groups)
  `(progn
     (clear-window-placement-rules)
     ,@(loop
         for (target-group . rules) in groups
         collect `(define-frame-preference ,target-group
                    ,@rules))))

(define-frame-preferences
  ("Default"
   (3 t t :class "Emacs")
   (1 t nil :class "Google-chrome-unstable"))
  ("Spotify"
   (0 nil t :class "Spotify"))
  ("Pidgin"
   (0 nil t :class "Pidgin" :role "buddy_list")
   (2 nil t :class "Pidgin" :role "conversation"))
  ("Libreoffice"
   (0 t t :instance "libreoffice" :create t)))

;;;
;;;  General settings
;;;

(set-prefix-key (stumpwm:kbd "F12"))
(setf *mouse-focus-policy* :click)

;;;
;;;  Keybinds
;;;

(define-key *root-map* (kbd "c") "exec gnome-terminal")
(define-key *root-map* (kbd "C-c") "chrome-unstable")
(define-key *root-map* (kbd "M-c") "chrome-unstable-new")
(define-key *root-map* (kbd "C-l") "lock-screen")
(define-key *root-map* (kbd "v") "dynamic-update-volume")
(define-key *groups-map* (kbd "F") "gnew-float")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (when (eq *client-location* :em-desktop)
    (defmethod stumpwm-dbus:record-notification ((msg stumpwm-dbus:notification))
      (not (equal (stumpwm-dbus:notification/app-name msg) "Spotify")))))

(when (eq *client-location* :em-desktop)
  (restore-from-file "~/.stumpwm.d/Desktop")
  (sleep 2)
  (emacs)
  (chrome-unstable)
  ;;(run-shell-command "pidgin")
  (stumpwm-dbus:start-notifications-thread))