265 lines
9.2 KiB
Common Lisp
265 lines
9.2 KiB
Common Lisp
;; -*-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
|