sawfishrc

;;
;; .sawfish/rc -- Sawfish window manager configuration file
;; Copyright 2008-2015 by Michal Nazarewicz
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;

(define sawfish-quit-cmd-file (getenv "SAWFISH_QUIT_CMD_FILE"))
(if sawfish-quit-cmd-file (unsetenv "SAWFISH_QUIT_CMD_FILE"))

;;{{{ What machine are we running

(defun screen-size ()
  "Screen resolution formatted as WIDTHxHEIGHT."
  (concat (number->string (screen-width)) "x" (number->string (screen-height))))

;;}}}
;;{{{ Helper

(require 'sawfish.wm.util.window-order)

(define (mn-run command)
  "Runs command asynchronously with a double fork to separate running
program from Sawfish process.

COMMAND is a string representing command to run.  It will be executed
via `system' function with additional ampersand at the end so that the
double fork followed by the middle process exiting happens."
  (format standard-error ">> %s\n" command)
  (system (concat command " & type disown >/dev/null 2>&1 && disown -a")))

(define (mn-run-unless regexp command #!optional current-vp)
  "Searches for window which WM_CLASS (formatted as %s/%s) matches
REGEXP.  If found returns this window otherwise runs COMMAND (in
background) and returns nil.

COMMAND is executed using `mn-run' function.

If current-vp is not-nil, will look only through windows in current
viewport.

Windows are matched in most recently focused first order."
  (catch 'done
    (mapc
     (lambda (w)
       (let ((cls (get-x-text-property w 'WM_CLASS)))
         (and cls
              (string-match regexp
                            (format nil "%s/%s"
                                    (and (> (length cls) 1) (aref cls 1))
                                    (aref cls 0)))
              (throw 'done w))))
     (window-order current-workspace t (not current-vp)))
    (mn-run command)
    ()))

;;}}}
;;{{{ Misc

;; Show errors on screen and standard-error
(require 'sawfish.wm.ext.error-handler)
(setq error-destination 'both)

(write standard-error "Sawfish starting...\n")

;; Win key as prefix
(custom-set-typed-variable
 (quote wm-modifier-value) (quote (super)) (quote modifier-list))

;; Focus and Auto Raise
(require 'sawfish.wm.ext.auto-raise)
(setq focus-mode             'enter-only
      focus-click-through    t
      raise-windows-on-focus nil
      raise-window-timeout   200)

;; Moving and resizing
(require 'sawfish.wm.commands.move-resize)
(setq move-show-position     t
      resize-show-dimensions t
      move-outline-mode      'box
      resize-outline-mode    'box
      move-snap-epsilon      5
      move-snap-mode         'magnetism)

(bind-keys window-keymap
           "W-Button2-Click"
           (lambda () (raise-lower-window-and-transients (input-focus)))
           "W-Button1-Move"
           (lambda () (move-window-interactively  (input-focus)))
           "W-Button3-Move"
           (lambda () (resize-window-interactively(input-focus))))

;; Viewports
(set-number-of-viewports 10 1)

; W-F<num> switches to viewport <num>-1
; W-<num> moves current window to viewport <num>-1
; expect <num> on dvorak are not numbers.
(do ((i 0 (1+ i)) (keys "&[{}(=*)+]"))
    ((= i (length keys)))
  (bind-keys global-keymap
             (concat "W-F" (number->string (1+ i)))
             (lambda () (set-screen-viewport i 0)))
  (bind-keys window-keymap
             (concat "W-" (elt keys i))
             (lambda () (set-window-viewport (input-focus) i 0))))
(bind-keys global-keymap
           "W-Button4-Click"
           (lambda ()
             (set-screen-viewport (% (1+ (car (screen-viewport))) 10) 0)))
(bind-keys global-keymap
           "W-Button5-Click"
           (lambda ()
             (set-screen-viewport (% (+ 9 (car (screen-viewport))) 10) 0)))

;;}}}
;;{{{ Transparency

(define default-window-alpha (cons 0.9 0.7))

(defconst window-alpha-max   #xffffffff)
(defconst window-alpha-min   #x1fffffff)

;; If alpha is a list then:
;; * if blur is nil     takes alpha's car,
;; * if blur is not nil takes alpha's cdr.
;; If now alpha is not a number returns `window-alpha-max'.
;; If alpha is within [0, 1] mueltiplies it by `window-alpha-max'
;; Returns (max `window-alpha-min' (min `window-alpha-max' alpha))
(defun window-alpha-value (alpha blur)
  (let ((a (if (listp alpha) (if blur (cdr alpha) (car alpha)) alpha)))
    (if (numberp a)
        (clamp (or (and (>= a 0) (<= a 1) (* a window-alpha-max)) a)
               window-alpha-min window-alpha-max)
      window-alpha-max)))

;; Return's window's alpha property or `default-window-alpha'
(defun window-alpha-get (w)
  (or (window-get w 'alpha) default-window-alpha))

(defun window-alpha-put (w #!optional alpha)
  (when (if (not alpha)
            (window-remprop w 'alpha)
          (window-put w 'alpha alpha)
          t)
    (set-window-alpha w (or alpha default-window-alpha)
                      (not (eq w (input-focus))))))

;; Sets window opacity.
;; If alpha is nil uses `window-alpha-get'.
;; Uses `window-alpha-value' to get alpha value from alpha and blur arguments.
(defun set-window-alpha (wnd alpha #!optional blur)
  (let ((a (window-alpha-value (or alpha (window-alpha-get wnd)) blur))
        (wid (window-frame-id wnd)))
    (if (< a window-alpha-max)
        (set-x-property wid '_NET_WM_WINDOW_OPACITY
                        (make-vector 1 a) 'CARDINAL 32)
      (delete-x-property wid '_NET_WM_WINDOW_OPACITY)))
  (sync-server))

(add-hook 'focus-in-hook  (lambda (w fmode) (set-window-alpha w nil nil)))
(add-hook 'focus-out-hook (lambda (w fmode) (set-window-alpha w nil t  )))

; If there are windows present when sawfish starts handle them properly,
; that's what after-add-window-hook is for, but after sawfish is
; started there is no longer need to keep this hook, so
; after-initialisation-hook removes the other hook.
(let ((f (lambda (w) (set-window-alpha w nil (not (eq (input-focus) w))))))
  (add-hook 'after-add-window-hook f)
  (add-hook 'after-initialization-hook
            (lambda () (remove-hook 'after-add-window-hook f))))

;;}}}
;;{{{ Applications, menus & bindings

(require 'sawfish.wm.menus)
(require 'sawfish.wm.customize)

(setq xterm-program    "term -N Term")
(define mn-mpdshow-command "term -N MPD -mesg -g 80x1 -e mpd-show")
(define mn-irssi-command   "term -N IRC -mesg -g 80x10 -e irssi")

;; Menus
(define (mn-quit command)
  (if sawfish-quit-cmd-file
      (let ((fd (open-file sawfish-quit-cmd-file 'write)))
        (write fd (concat command "\n"))
        (close-file fd)))
  (quit))

(setq root-menu
      (nconc
       '(("_Customize"    customize)
         ("_Restart"      restart)
         ("_Quit"         ("Yes" quit))
         ("Reboo_t"       ("Yes" (mn-quit "reboot"))))
       (and (file-exists-p "/usr/local/sbin/reboot-w")
            '(("_Windows" ("Yes" (mn-quit "reboot-w")))))
       '(("_Power Off"    ("Yes" (mn-quit "poweroff"))))))

(define (mn-window-opaque-p wnd)
  (>= (window-alpha-value (window-alpha-get wnd) nil) window-alpha-max))

(define (mn-toggle-opaque)
  (let ((wnd (input-focus)))
    (window-alpha-put wnd (if (mn-window-opaque-p wnd) nil (cons 1 0.7)))))

(add-window-menu-toggle "Opa_que" mn-toggle-opaque mn-window-opaque-p)

;; Bindings
(bind-keys root-window-keymap
           "Button3-Click"    popup-root-menu)

(bind-keys window-keymap
           "W-Space"         (lambda () (popup-window-menu (input-focus))))

(mapc
 (lambda (spec)
   (when (cdr spec)
     (bind-keys
      global-keymap
      (car spec)
      (let ((spec (cdr spec)))
        (if (listp spec)
            (lambda ()
              (display-window (apply mn-run-unless spec)))
          (lambda ()
            (mn-run spec)))))))

 (let* ((home (getenv "HOME"))
        (libexec (concat home "/.local/libexec/"))
        (sh-maybe (lambda (dir fname #!optional args)
                    (let ((fname (concat dir fname)))
                      (if (file-exists-p fname)
                          (concat "/bin/sh " fname (or args "")))))))
   `(("W-;" "^Emacs/emacs$"  "e")
     ("W-." "/IRC$"          ,mn-irssi-command)
     ("W-a" "GIMP"           "gimp")
     ("W-o" "Geeqie"         "geeqie")
     ("Pause"               . ,(sh-maybe libexec "xlocker"))
     ("Scroll_Lock"         . "killall xcompmgr")
     ("Print"               . ,(sh-maybe libexec "xlocker"))
     ("W-\""                . "m rewind")
     ("W-'"                 . "m prev")
     ("W-j"                 . "m toggle")
     ("W-k"                 . "m next")
     ("XF86Display"         . ,(sh-maybe home "/.xscreen-config"))
     ("XF86MonBrightnessUp"   . "xbacklight + 25")
     ("XF86MonBrightnessDown" . "xbacklight - 25"))))

(define (mn-get-browser-priority wnd)
  (let ((cls (get-x-text-property wnd 'WM_CLASS)))
    (when (> (length cls) 1)
      (catch 'return
        (mapc (lambda (spec)
                (and (string= (car spec) (aref cls 0))
                     (or (not (cadr spec))
                         (string= (cadr spec) (aref cls 1)))
                     (throw 'return (cddr spec))))
              '(("Navigator"     "Firefox-esr" . 0)
                ("Navigator"     "Firefox"     . 0)
                ("opera"         ()            . 1)
                ("chromium"      ()            . 2)
                ("Google-chrome" ()            . 3)
                ("Navigator"     ()            . 4)))))))

;;; Looks for a web browser to select.  Switches to a window which currently
;;; doesn’t hold input focus prioritising windows as follows:
;;;
;;; * non-iconified windows are preferred over iconified windows,
;;; * windows visible on current view-port are preferred over other windows and
;;; * Firefox > Opera > Chromium > Chrome.
;;;
;;; If no browser window is found starts Firefox.
(define (mn-get-browser)
  (let ((focused (input-focus))
        (best-pri 1000) best found-firefox)
    ;; If focused window is outside of current viewport pretend it’s not
    ;; focused.  This is needed if we switch to far away viewport while
    ;; retaining focus in a browser window.
    (when (window-outside-viewport-p focused)
      (setq focused nil))
    (map-windows
     (lambda (wnd)
       (let ((pri (mn-get-browser-priority wnd)))
         (when (= pri 0)
           (setq found-firefox t))
         (when (and pri
                    (not (and focused
                              (memq focused (transient-group wnd)))))
           (when (window-outside-viewport-p wnd) (setq pri (+ pri 10 )))
           (when (window-iconified-p        wnd) (setq pri (+ pri 100)))
           (when (< pri best-pri)
             (setq best-pri pri best wnd))))
       (/= best-pri 0)))
    (if best
        (display-window (or (last (transient-children best t)) best))
      (or found-firefox (mn-run "firefox")))))

(bind-keys global-keymap "W-," mn-get-browser)

;;; Returns t if given window is a terminal window.  More specifically, whether
;;; window’s WM_CLASS is Term.
(define (mpn-terminal-window-p wnd)
  (let ((cls (get-x-text-property wnd 'WM_CLASS)))
    (and cls (string-equal "Term" (aref cls 0)))))

;;; Selects terminal window in current view-port or starts a terminal.
;;;
;;; Also warps mouse to the centre of the window if not already above it."
(define (mn-get-term)
  (let ((terms (delete-if-not mpn-terminal-window-p
                              (window-order current-workspace t))))
    (if terms
        ;; If there are at least two terminal windows and the first one has
        ;; input focus, display the second one.  Otherwise, display the first
        ;; one.
        (display-window
         (or (and (eq (car terms) (input-focus)) (cadr terms)) (car terms)))
      ;; No terminal windows, start a new one.
      (mn-run xterm-program))))

(setq warp-to-window-enabled t
      warp-to-window-offset (cons 50 50))

(bind-keys global-keymap "W-$" mn-get-term)


(require 'sawfish.wm.ext.run-application)
(setq run-application:y-position 'top)
(bind-keys global-keymap "W-r" 'run-application)

(let ((map (make-keymap))
      (make-cmd (lambda (cmd)
                  (lambda ()
                    (when (numberp cmd)
                      (setq cmd (format nil "Master %d%%" cmd)))
                    (mn-run (concat "amixer set " cmd))))))
  (let ((chars ";,.aoe'qjk") (i 0) ch)
    (while (< i (length chars))
      (setq ch (aref chars i) i (1+ i))
      (bind-keys map
                 (concat ""   ch) (make-cmd (- (* i 10) 5))
                 (concat "W-" ch) (make-cmd (* i 10)))))
  (bind-keys map
             "W-p" (make-cmd "Master toggle")
             "u"   (make-cmd "Master 70%")
             "W-u" (make-cmd "Master 50%"))
  (bind-keys global-keymap
             "W-u" map
             "XF86AudioLowerVolume" (make-cmd "Master 10%-")
             "XF86AudioRaiseVolume" (make-cmd "Master 10%+")
             "XF86AudioMute"        (make-cmd "Master toggle")
             "XF86AudioMicMute"     (make-cmd "Capture toggle")))

; Having Super-Tab bound seems to overwrite existing W-Tab binding.
; cabinet-switch is nice and all, but having it under W-Tab is not what I want.
; Unbind Super-Tab to get cycle-windows back.
(unbind-keys global-keymap "Super-Tab")
; Also unbind C-Tab since this is used for switching tabs in a browser.
(unbind-keys global-keymap "C-Tab")

;; Window manipulations
(setq grow-is-maximize nil)
(bind-keys window-keymap
           ;; Move to an edge
           "W-c"   'pack-window-up
           "W-t"   'pack-window-down
           "W-h"   'pack-window-left
           "W-n"   'pack-window-right
           ;; Grow to an edge
           "W-C"   'grow-window-up
           "W-T"   'grow-window-down
           "W-H"   'grow-window-left
           "W-N"   'grow-window-right
           ;; Shrink till it overlaps with one less window
           "C-W-c" 'shrink-window-up
           "C-W-t" 'shrink-window-down
           "C-W-h" 'shrink-window-left
           "C-W-n" 'shrink-window-right
           ;; Move till it overlaps with one less window
           "C-W-C" 'yank-window-up
           "C-W-T" 'yank-window-down
           "C-W-H" 'yank-window-left
           "C-W-N" 'yank-window-right)


;; Run some applications
(add-hook 'after-initialization-hook
          (lambda ()
            (let ((sn (system-name)))
              (mapc
               (lambda (spec)
                 (when (string-looking-at (car spec) sn)
                   (apply mn-run-unless (cdr spec))))
               `((""                  "^Emacs/emacs$" "e")))
            (set-screen-viewport 0 0))))

;;}}}

;; Desktop background

(let ((set-bg-script (concat (getenv "HOME") "/.local/libexec/set-bg")))
  (when (file-exists-p set-bg-script)
    (require 'rep.io.timers)

    (define set-bg--timer (make-timer (lambda (_) (set-bg))))

    (define (set-bg--state-func proc)
      (set-timer set-bg--timer (if (= (process-exit-value proc) 0) 900 10)))

    (define (set-bg)
      (delete-timer set-bg--timer)
      (start-process (let ((proc (make-process)))
                       (set-process-output-stream proc standard-output)
                       (set-process-error-stream proc standard-error)
                       (set-process-function proc set-bg--state-func)
                       (set-process-dir proc "/")
                       (set-process-prog proc set-bg-script)
                       proc))
      ())

    (set-bg)
    (set-hook 'randr-change-notify-hook set-bg)
    (bind-keys root-window-keymap "Button1-Click2" set-bg)))

;;{{{ Matcher

(define-frame-type-mapper
  (lambda (wnd type)
    (if (window-transient-p wnd)
        type
      'unframed)))

(require 'sawfish.wm.ext.match-window)

(define-match-window-setter 'location
  (lambda (wnd prop value)
    (declare (unused prop))
    (let ((x (nth 0 value)) (y (nth 1 value))
          (w (nth 2 value)) (h (nth 3 value))
          (v (nth 4 value)))
      ; Position
      (when (and x y)
        (when (< x 0) (setq x (+ (screen-width ) x)))
        (when (< y 0) (setq y (+ (screen-height) y)))
        (window-put wnd 'ignore-program-position #t)
        (move-window-to wnd x y))
      ; Dimensions
      (when (and w h)
        (resize-window-with-hints wnd w h))
      ; Viewport (maybe)
      (when v
        (set-screen-viewport     (1- v) 0)
        (set-window-viewport wnd (1- v) 0))
      ; Maximize (maybe)
      (when (and x w (= x 0) (= w (screen-width)))
        (window-put wnd 'queued-horizontal-maximize #t))
      (when (and y h (= y 0) (= h (screen-height)))
        (window-put wnd 'queued-horizontal-maximize #t)))))

;; (define-match-window-matcher 'screen
;;   (lambda (w _prop value)
;;     (and (let ((w) (car value)) (or (not w) (= (screen-width ) w)))
;;          (let ((h) (car value)) (or (not h) (= (screen-height) h))))))


(let ((match-screen (lambda (_wnd width height)
                      (and (or (eq t width)
                               (= width (screen-width)))
                           (or (eq t height)
                               (= height (screen-height))))))
      (first-term-p (lambda (wnd)
                      (and (mpn-terminal-window-p wnd)
                           (do ((wnds (managed-windows) (cdr wnds)))
                               ((or (null wnds)
                                    (and (not (eq (car wnds) wnd))
                                         (mpn-terminal-window-p (car wnds))))
                                (null wnds)))))))
  (setq match-window-profile
        (apply nconc
               (mapcar
                (lambda (profile-set)
                  (when (stringp (caar profile-set))
                    (setcar (car profile-set)
                            (cons 'WM_CLASS (caar profile-set))))
                  (mapcar (lambda (profile)
                            (let ((matches (car profile-set)))
                              (when (or (numberp (car profile))
                                        (eq t (car profile)))
                                (setq matches (cons (list match-screen
                                                          (car profile)
                                                          (cadr profile))
                                                    matches)
                                      profile (cddr profile)))
                              (cons matches profile)))
                          (cdr profile-set)))
                `((("^Emacs/emacs$")
                   (4160 2560  (location  136    0  1464 2560  1)))

                  (((,first-term-p))
                   (4160 2560  (location 1600    0   906 1440)))

                  (("^Firefox(-esr)?/Navigator$")
                   (4160 2560  (location 2506    0  1654 1440  1)))

                  (("^MPlayer/|^mpv/|^openttd/|^Inkscape/|^[Vv]irt-manager/|^gzdoom/")
                   (           (alpha 1 . 1)))
                  (("^Gimp/|^Inkscape/")
                   (           (alpha 1 . 0.7)))

                  ;; GIMP
                  (("^Gimp/gimp$" (WM_WINDOW_ROLE . "^gimp-[^s]"))
                   (           (viewport 2 . 1) (group . Gimp)))

                  (("^Gimp/gimp$" (WM_WINDOW_ROLE . "^gimp-startup$"))
                   (           (place-mode . centered) (depth . 16)
                               (never-focus . #t) (focus-when-mapped . #f)
                               (sticky-and-skip . #t)))

                  ;; Geeqie
                  (((WM_ICON_NAME . "Geeqie$"))
                   (           (viewport 3 . 1) (alpha 1 . 1))))))))

;;}}}

; (restart)