linux.14

====
;;;
;;; StumpWM configuration file by Andrew Lobanov
;;; 2017-12-05
;;;

(ql:quickload :swank)
(swank-loader:init)
(defcommand swank () ()
    (swank:create-server :port 4006
                       :style swank:*communication-style*
                       :dont-close t)
  (echo-string (current-screen) 
       "Starting swank. M-x slime-connect RET RET, then (in-package stumpwm)."))
(swank)

(in-package :stumpwm)

;;;
;;; Groups
;;;
(grename "first")
(gnewbg "web")
(gnewbg "media")
(gnewbg "emacs")
(gnewbg "file")
(gnewbg "other")
(gnewbg "code")
(gnewbg "gfx")
(gnewbg "mail")
(gnewbg "down")
(gnewbg "vm")
(gnewbg "games")

;;;
;;; Apearence
;;;
(set-fg-color "#aaaaaa")
(set-bg-color "#242424")
(set-border-color "#005577")
(set-focus-color "#005577")
(set-font "-*-terminus-medium-r-*-*-14-*-*-*-*-*-iso10646-1")
(setf *message-window-padding* 5)
(setf *message-window-gravity* :center)
(setf *input-window-gravity* :center)

;;;
;;; Time format
;;;
(setf *time-format-string-default* "%d.%m.%Y %A %H:%M")
(setf *time-day-names*
      #("Понедельник" "Вторник" "Среда" "Четверг" "Пятница" "Суббота" "Воскресение"))

;;;
;;; Menu
;;;
(defparameter *app-menu* '(("binkd" "urxvt -fn 'xft:terminus:size=14:bold' -fb 'xft:terminus:size=14:bold' -title binkd -e rs")
			   ("caesium" "cd ~/idec && urxvt -fn 'xft:Terminus:pixelsize=18:bold' -fb 'xft:Terminus:pixelsize=18:bold' -title Caesium -e ./caesium.py")
			   ("golded" "LANG=ru_RU.koi8-r urxvt -g '136x41' -fn 'xft:Terminus:pixelsize=18:bold' -fb 'xft:Terminus:pixelsize=18:bold' -title GoldEd -e ge")
			   ("moc" "urxvt -title MOCP -e mocp")
			   ("rtorrent" "urxvt -title rtorrent -e rtorrent")
			   ("wbinkd" "urxvt -fn 'xft:terminus:size=14:bold' -fb 'xft:terminus:size=14:bold' -title binkd -e wrs")
			   ("wcaesium" "cd ~/idec && urxvt -fn 'xft:Terminus:pixelsize=18:bold' -fb 'xft:Terminus:pixelsize=18:bold' -title Caesium -e ./work.sh")))

(defcommand mymenu () ()
  (labels ((pick (options)
             (let ((selection (stumpwm::select-from-menu (current-screen) options "")))
               (cond
                 ((null selection)
                  (throw 'stumpwm::error "Abort."))
                 ((stringp (second selection))
                  (second selection))
                 (t
                  (pick (cdr selection)))))))
    (let ((choice (pick *app-menu*)))
      (run-shell-command choice))))

;;;
;;; Mode-line
;;;
(load-module "disk")
(load-module "cpu")
(load-module "mem")
(load-module "battery-portable")
(load-module "pager")

(setf disk:*disk-usage-paths* '("/home"))
(setf *time-modeline-string* "%d.%m.%Y %A %H:%M")

(setf *mode-line-foreground-color* "#aaaaaa")
(setf *mode-line-background-color* "#242424")
(setf *mode-line-position* :top)
(setf *mode-line-border-width* 0)
(setf *mode-line-pad-x* 0)
(setf *mode-line-pad-y* 0)
(setf *mode-line-timeout* 5)
(setf disk:*disk-modeline-fmt* "%m: %a")
(setf *screen-mode-line-format*
      (list "%P^>"
			"%B │ %D│ %d "))
(mode-line)

(defcommand screenshot (select-window) ((:y-or-n "Select window "))
  "Make a screenshot."
  (redisplay)
  (if select-window
      (echo (run-shell-command "~/programs/screen.sh -s" t))
      (echo (run-shell-command "~/programs/screen.sh" t))))

;;;
;;; Key bindings
;;;
(define-key *root-map* (kbd "c") "exec urxvt")
(define-key *root-map* (kbd "P") "screenshot")
(define-key *root-map* (kbd ".") "mymenu")
(define-key *root-map* (kbd "a") "status")
(define-key *root-map* (kbd "l") "run-shell-command slock")
(define-key *root-map* (kbd "B") "mode-line")
(define-key *root-map* (kbd "F10") "gselect down")
(define-key *root-map* (kbd "F11") "gselect vm")
(define-key *root-map* (kbd "F12") "gselect games")
(define-key *top-map* (kbd "M-F5") "exec xbacklight -dec 10")
(define-key *top-map* (kbd "M-F6") "exec xbacklight -inc 10")

;;;
;;; Workspaces rules
;;;
(define-frame-preference "web"
    (0 nil t :instance "Navigator"))

(define-frame-preference "media"
    (0 nil t :title "MOC"))

(define-frame-preference "emacs"
    (0 nil t :class "Emacs"))

(define-frame-preference "gfx"
    (0 nil t :class "Gimp")
  (1 nil t :class "Geeqie"))

(define-frame-preference "mail"
    (0 nil t :title "Caesium")
  (1 nil t :title "binkd")
  (2 nil t :title "GoldEd+"))

(define-frame-preference "down"
    (0 nil t :title "rtorrent")
  (1 nil t :instance "Places")
  (2 nil t :instance "DTA"))
====

====
(defpackage #:pager
  (:use #:cl :stumpwm))

(in-package #:pager)

(import '(
		  stumpwm::sort-groups
		  stumpwm::current-screen
		  stumpwm::group-windows
		  stumpwm::group-name))
====

====
;;;; pager.asd

(asdf:defsystem #:pager
  :description "i3wm-like pager"
  :author "Andrew Lobanov <spline@rooker.ru>"
  :license "GPLv3"
  :depends-on (#:stumpwm)
  :serial t
  :components ((:file "package")
  (:file "pager")))
====

====
(in-package #:pager)

(defun pager (ml)
  (declare (ignore ml))
  (let (g)
    (dolist (group (sort-groups (current-screen)))
      (if (eq (current-group) group)
	      (push (concatenate 'string "^(:fg \"#eeeeee\")^(:bg \"#005577\") " (group-name group) " ^n") g)
	      (if (group-windows group)
		  (push (concatenate 'string " " (group-name group) " ") g))))
    (format nil "~{~a~}" (reverse g))))

(add-screen-mode-line-formatter #\P #'pager)
====