;; -*-lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INDEX                                                    ;;;
;;; - DEPRECATED - MANIFEST                                  ;;;
;;; - SWANK INTERACTION                                      ;;;
;;; - GENERAL CONFIG                                         ;;;
;;; - UTILITY FUNCTIONS                                      ;;;
;;; - KEY BINDING                                            ;;;
;;; - EXECUTION                                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DEPRECATED - MANIFEST                                    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; without the ability to select localhost-only, we can't use
;; manifest at this time.
;; (defvar *manifest-url*
;;   (manifest:start))
;; (defun browse-manifest ()
;;   (format nil "exec ~A ~A" *default-browser* *manifest-url*))
;; (define-key *root-map* (kbd "C-d") (browse-manifest))

;; "Don't know how to REQUIRE SB-CLTL2"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SWANK INTERACTION                                        ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; swank interaction allows us to connect to the StumpWM
;; process from emacs while it's running.
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
                                      (user-homedir-pathname))))
 (when (probe-file quicklisp-init)
   (load quicklisp-init)))
(ql:quickload :swank)

(let ((server-running nil))
 (defcommand swank () ()
   "Toggle the swank server on/off"
   (if server-running
       (progn
         (swank:stop-server 4005)
         (echo-string
          (current-screen)
          "Stopping swank.")
         (setf server-running nil))
       (progn
         (swank:create-server :port 4005
                              :style swank:*communication-style*
                              :dont-close t)
         (echo-string
          (current-screen)
          "Starting swank. M-x slime-connect RET RET, then (in-packqage stumpwm).")
        (setf server-running t)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GENERAL CONFIG                                           ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this is where configuration parameters, the frame numbering
;; and switching, and other general configuration is set up.

(defparameter *default-browser* "firefox")
(defparameter *default-terminal* "mate-terminal")

;; make frames 1-numbered (i.e. for getting with ALT-FN)
(setf *frame-number-map* "1234567890")

(run-commands
 "gnewbg G2"     ;; F2
 "gnewbg G3"     ;; F3
 "gnewbg G4"     ;; F4
 "gnewbg G5"     ;; F5
 "gnewbg G6"     ;; F6
 "gnewbg G7"     ;; F7
 "gnewbg G8"     ;; F8
 "gnewbg G9"     ;; F9
 "gnewbg G10"    ;; F10
 "gnewbg G11"    ;; F11
 "gnewbg G12"
 "gnewbg G13"
 "gnewbg G14"
 "gnewbg G15"
 "gnewbg G16"
 "gnewbg G17"
 "gnewbg G18"
 "gnewbg G19")


;; Fluxbox-style Alt-F# virtual desktop (group in StumpWM-speak)
;; switching. Modified from:
;; http://hcl-club.lu/svn/development/lisp/.stumpwmrc
(loop for i from 1 to 9
   do
     (progn
       (format t "Key: ~A~%" i)
       (define-key *top-map*
           (kbd (format nil "M-~a" i))
         (format nil "gselect ~a" i))))

(define-key *top-map* (kbd "M-!") "gselect 10")
(define-key *top-map* (kbd "M-@") "gselect 11")
(define-key *top-map* (kbd "M-#") "gselect 12")
(define-key *top-map* (kbd "M-$") "gselect 13")
(define-key *top-map* (kbd "M-%") "gselect 14")
(define-key *top-map* (kbd "M-^") "gselect 15")
(define-key *top-map* (kbd "M-&") "gselect 16")
(define-key *top-map* (kbd "M-*") "gselect 17")
(define-key *top-map* (kbd "M-\(") "gselect 18")
(define-key *top-map* (kbd "M-\)") "gselect 19")

;; scale up the font
(let ((font-size 22))
  (stumpwm:set-font
   (format nil "-*-*-bold-r-*-*-~D-240-*-*-*-*-*-*"
	   font-size)))

;; set FFM
(setf *mouse-focus-policy* :sloppy)

;; show input bar in centre of screen
(setf *input-window-gravity* :center)

;; enable the mode-line (and preferably the system tray)

(setf *mode-line-position* :bottom)

;;(load-module "stumptray")

(dolist
    (head (screen-heads (current-screen)))
  (toggle-mode-line (current-screen) head))

;; (stumptray::stumptray)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; UTILITY FUNCTIONS                                        ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *exec-base* #P "/usr/bin/")

(defvar *scratchpad* nil)
(defcommand scratch-pad () ()
  "Create or destroy a new scratchpad group."
  (if *scratchpad*
      (progn
        (gselect *scratchpad*)
        (dolist (window (group-windows (current-group)))
          (delete-window window))
        (gkill)
        (setf *scratchpad* nil)
        (echo "nerfed scratchpad"))
      (progn
        (setf *scratchpad* (gnew "scratchpad"))
        (echo "scratchpad created"))))

(defvar *scratchpad-float* nil)
(defcommand scratch-pad-float () ()
  "Create or destroy a new floating scratchpad group."
  (if *scratchpad-float*
      (progn
        (gselect *scratchpad-float*)
        (dolist (window (group-windows (current-group)))
          (delete-window window))
        (gkill)
        (setf *scratchpad-float* nil)
        (echo "nerfed floating scratchpad"))
      (progn
        (setf *scratchpad-float* (gnew "scratchpad-float"))
        (echo "floating scratchpad created"))))

(defcommand acpi-status () ()
  "Print ACPI status in the StumpWM message box."
  (stumpwm:echo-string (current-screen)
                       (with-output-to-string (stream)
                         (sb-ext:run-program
                          (format nil  "~A/acpitool" *exec-base*)
                          nil
                          :output stream))))

(defun stumpwm-run-program (program)
  (sb-ext:run-program
   (format nil  "~A/~A" *exec-base* program) nil))

(defcommand lock () ()
  "Lock the screen by invoking xautolock."
  (stumpwm:echo-string (current-screen) "Locking screen...")
  (sb-ext:run-program
   (format nil  "~A/~A" *exec-base* "xautolock") "-locknow" nil))

(defun exec-for-status (path &rest args)
  "Run the path with args and return the status code."
  (sb-ext:process-exit-code
   (sb-ext:run-program path args :wait t)))

(defun exec-ok (path &rest args)
  "Returns true if path with args ran without error."
  (zerop (exec-for-status path args)))

(defun daemon-is-running (daemon)
  (zerop (exec-for-status "/usr/bin/pgrep" daemon)))

(defun start-daemon-if-not-running (path &rest args)
  "If the program specified at path isn't running, start it."
  (when (not (daemon-is-running (pathname-name path)))
    (run-shell-command (if (null args)
                           path
                           (format nil "~A~{ ~A~}" path args)))))

(defun start-program-if-not-running (program &rest args)
  (format t "WOULD RUN: nohup ~A~{ ~A~}" program args)
  (when (not (exec-ok "/usr/bin/pgrep" program))
    (run-shell-command (format nil "nohup ~A~{ ~A~}"
                               program args))))

(defun with-terminal (&key (run "" run-p) (term *default-terminal*))
  (concat "exec " term (if run-p " -e " "") run))

(defun with-homedir (path)
  (merge-pathnames path (user-homedir-pathname)))

(defun in-homedir-p (path)
  (probe-file (with-homedir path)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DEMON^WKEY BINDING                                       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-key stumpwm:*root-map* (kbd "B") "exec firefox")
(define-key stumpwm:*root-map* (kbd "c") (with-terminal))
(define-key *root-map* (kbd "b") "acpi-status")
(define-key *root-map* (kbd "RET") (with-terminal))
(define-key *root-map* (kbd "d") "exec dmenu_run")
(define-key *root-map* (kbd "D") "exec i3-dmenu-desktop")
(define-key *root-map* (kbd "e") "exec emacsclient -c -a \"\"")
(define-key *root-map* (kbd "E") (with-terminal :run "'emacsclient -c -nw -a \"\"'"))
(define-key *root-map* (kbd "g") (with-terminal :run "ghci"))
(define-key *root-map* (kbd "C-i") (with-terminal :run "ipython"))
(define-key *root-map* (kbd "l") "exec i3lock")
(define-key *root-map* (kbd "C-l") (with-terminal :run "rlwrap sbcl"))
(define-key *root-map* (kbd "M") (with-terminal :run "htop"))
(define-key *root-map* (kbd "C-s") "swank")
(define-key *root-map* (kbd "C-v") "exec pavucontrol")
(define-key *root-map* (kbd "w") (with-terminal :run "nmtui-connect"))
(define-key *root-map* (kbd "`") "scratch-pad")
(define-key *root-map* (kbd "~") "scratch-pad-float")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EXECUTION                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(run-shell-command "ssh-add")

(when (in-homedir-p ".fehbg")
  (sb-ext:run-program "/bin/sh" (with-homedir ".fehbg")))
(when (in-homedir-p ".screenlayouts/norminal.sh")
  (run-shell-command (with-homedir ".screenlayouts/norminal.sh")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THIS BATTLESTATION IS FULLY OPERATIONAL                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(message "Ready.")

;;LISP=sbcl