sawfishrc

   1 ;;
   2 ;; .sawfish/rc -- Sawfish window manager configuration file
   3 ;; Copyright 2008-2015 by Michal Nazarewicz
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or
   6 ;; modify it under the terms of the GNU General Public License as
   7 ;; published by the Free Software Foundation, either version 3 of the
   8 ;; License, or (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful, but
  11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17 ;;
  18
  19 (define sawfish-quit-cmd-file (getenv "SAWFISH_QUIT_CMD_FILE"))
  20 (if sawfish-quit-cmd-file (unsetenv "SAWFISH_QUIT_CMD_FILE"))
  21
  22 ;;{{{ What machine are we running
  23
  24 (defun screen-size ()
  25   "Screen resolution formatted as WIDTHxHEIGHT."
  26   (concat (number->string (screen-width)) "x" (number->string (screen-height))))
  27
  28 ;;}}}
  29 ;;{{{ Helper
  30
  31 (require 'sawfish.wm.util.window-order)
  32
  33 (define (mn-run command)
  34   "Runs command asynchronously with a double fork to separate running
  35 program from Sawfish process.
  36
  37 COMMAND is a string representing command to run.  It will be executed
  38 via `system' function with additional ampersand at the end so that the
  39 double fork followed by the middle process exiting happens."
  40   (format standard-error ">> %s\n" command)
  41   (system (concat command " & type disown >/dev/null 2>&1 && disown -a")))
  42
  43 (define (mn-run-unless regexp command #!optional current-vp)
  44   "Searches for window which WM_CLASS (formatted as %s/%s) matches
  45 REGEXP.  If found returns this window otherwise runs COMMAND (in
  46 background) and returns nil.
  47
  48 COMMAND is executed using `mn-run' function.
  49
  50 If current-vp is not-nil, will look only through windows in current
  51 viewport.
  52
  53 Windows are matched in most recently focused first order."
  54   (catch 'done
  55     (mapc
  56      (lambda (w)
  57        (let ((cls (get-x-text-property w 'WM_CLASS)))
  58          (and cls
  59               (string-match regexp
  60                             (format nil "%s/%s"
  61                                     (and (> (length cls) 1) (aref cls 1))
  62                                     (aref cls 0)))
  63               (throw 'done w))))
  64      (window-order current-workspace t (not current-vp)))
  65     (mn-run command)
  66     ()))
  67
  68 ;;}}}
  69 ;;{{{ Misc
  70
  71 ;; Show errors on screen and standard-error
  72 (require 'sawfish.wm.ext.error-handler)
  73 (setq error-destination 'both)
  74
  75 (write standard-error "Sawfish starting...\n")
  76
  77 ;; Win key as prefix
  78 (custom-set-typed-variable
  79  (quote wm-modifier-value) (quote (super)) (quote modifier-list))
  80
  81 ;; Focus and Auto Raise
  82 (require 'sawfish.wm.ext.auto-raise)
  83 (setq focus-mode             'enter-only
  84       focus-click-through    t
  85       raise-windows-on-focus nil
  86       raise-window-timeout   200)
  87
  88 ;; Moving and resizing
  89 (require 'sawfish.wm.commands.move-resize)
  90 (setq move-show-position     t
  91       resize-show-dimensions t
  92       move-outline-mode      'box
  93       resize-outline-mode    'box
  94       move-snap-epsilon      5
  95       move-snap-mode         'magnetism)
  96
  97 (bind-keys window-keymap
  98            "W-Button2-Click"
  99            (lambda () (raise-lower-window-and-transients (input-focus)))
 100            "W-Button1-Move"
 101            (lambda () (move-window-interactively  (input-focus)))
 102            "W-Button3-Move"
 103            (lambda () (resize-window-interactively(input-focus))))
 104
 105 ;; Viewports
 106 (set-number-of-viewports 10 1)
 107
 108 ; W-F<num> switches to viewport <num>-1
 109 ; W-<num> moves current window to viewport <num>-1
 110 ; expect <num> on dvorak are not numbers.
 111 (do ((i 0 (1+ i)) (keys "&[{}(=*)+]"))
 112     ((= i (length keys)))
 113   (bind-keys global-keymap
 114              (concat "W-F" (number->string (1+ i)))
 115              (lambda () (set-screen-viewport i 0)))
 116   (bind-keys window-keymap
 117              (concat "W-" (elt keys i))
 118              (lambda () (set-window-viewport (input-focus) i 0))))
 119 (bind-keys global-keymap
 120            "W-Button4-Click"
 121            (lambda ()
 122              (set-screen-viewport (% (1+ (car (screen-viewport))) 10) 0)))
 123 (bind-keys global-keymap
 124            "W-Button5-Click"
 125            (lambda ()
 126              (set-screen-viewport (% (+ 9 (car (screen-viewport))) 10) 0)))
 127
 128 ;;}}}
 129 ;;{{{ Transparency
 130
 131 (define default-window-alpha (cons 0.9 0.7))
 132
 133 (defconst window-alpha-max   #xffffffff)
 134 (defconst window-alpha-min   #x1fffffff)
 135
 136 ;; If alpha is a list then:
 137 ;; * if blur is nil     takes alpha's car,
 138 ;; * if blur is not nil takes alpha's cdr.
 139 ;; If now alpha is not a number returns `window-alpha-max'.
 140 ;; If alpha is within [0, 1] mueltiplies it by `window-alpha-max'
 141 ;; Returns (max `window-alpha-min' (min `window-alpha-max' alpha))
 142 (defun window-alpha-value (alpha blur)
 143   (let ((a (if (listp alpha) (if blur (cdr alpha) (car alpha)) alpha)))
 144     (if (numberp a)
 145         (clamp (or (and (>= a 0) (<= a 1) (* a window-alpha-max)) a)
 146                window-alpha-min window-alpha-max)
 147       window-alpha-max)))
 148
 149 ;; Return's window's alpha property or `default-window-alpha'
 150 (defun window-alpha-get (w)
 151   (or (window-get w 'alpha) default-window-alpha))
 152
 153 (defun window-alpha-put (w #!optional alpha)
 154   (when (if (not alpha)
 155             (window-remprop w 'alpha)
 156           (window-put w 'alpha alpha)
 157           t)
 158     (set-window-alpha w (or alpha default-window-alpha)
 159                       (not (eq w (input-focus))))))
 160
 161 ;; Sets window opacity.
 162 ;; If alpha is nil uses `window-alpha-get'.
 163 ;; Uses `window-alpha-value' to get alpha value from alpha and blur arguments.
 164 (defun set-window-alpha (wnd alpha #!optional blur)
 165   (let ((a (window-alpha-value (or alpha (window-alpha-get wnd)) blur))
 166         (wid (window-frame-id wnd)))
 167     (if (< a window-alpha-max)
 168         (set-x-property wid '_NET_WM_WINDOW_OPACITY
 169                         (make-vector 1 a) 'CARDINAL 32)
 170       (delete-x-property wid '_NET_WM_WINDOW_OPACITY)))
 171   (sync-server))
 172
 173 (add-hook 'focus-in-hook  (lambda (w fmode) (set-window-alpha w nil nil)))
 174 (add-hook 'focus-out-hook (lambda (w fmode) (set-window-alpha w nil t  )))
 175
 176 ; If there are windows present when sawfish starts handle them properly,
 177 ; that's what after-add-window-hook is for, but after sawfish is
 178 ; started there is no longer need to keep this hook, so
 179 ; after-initialisation-hook removes the other hook.
 180 (let ((f (lambda (w) (set-window-alpha w nil (not (eq (input-focus) w))))))
 181   (add-hook 'after-add-window-hook f)
 182   (add-hook 'after-initialization-hook
 183             (lambda () (remove-hook 'after-add-window-hook f))))
 184
 185 ;;}}}
 186 ;;{{{ Applications, menus & bindings
 187
 188 (require 'sawfish.wm.menus)
 189 (require 'sawfish.wm.customize)
 190
 191 (setq xterm-program    "term -N Term")
 192 (define mn-mpdshow-command "term -N MPD -mesg -g 80x1 -e mpd-show")
 193 (define mn-irssi-command   "term -N IRC -mesg -g 80x10 -e irssi")
 194
 195 ;; Menus
 196 (define (mn-quit command)
 197   (if sawfish-quit-cmd-file
 198       (let ((fd (open-file sawfish-quit-cmd-file 'write)))
 199         (write fd (concat command "\n"))
 200         (close-file fd)))
 201   (quit))
 202
 203 (setq root-menu
 204       (nconc
 205        '(("_Customize"    customize)
 206          ("_Restart"      restart)
 207          ("_Quit"         ("Yes" quit))
 208          ("Reboo_t"       ("Yes" (mn-quit "reboot"))))
 209        (and (file-exists-p "/usr/local/sbin/reboot-w")
 210             '(("_Windows" ("Yes" (mn-quit "reboot-w")))))
 211        '(("_Power Off"    ("Yes" (mn-quit "poweroff"))))))
 212
 213 (define (mn-window-opaque-p wnd)
 214   (>= (window-alpha-value (window-alpha-get wnd) nil) window-alpha-max))
 215
 216 (define (mn-toggle-opaque)
 217   (let ((wnd (input-focus)))
 218     (window-alpha-put wnd (if (mn-window-opaque-p wnd) nil (cons 1 0.7)))))
 219
 220 (add-window-menu-toggle "Opa_que" mn-toggle-opaque mn-window-opaque-p)
 221
 222 ;; Bindings
 223 (bind-keys root-window-keymap
 224            "Button3-Click"    popup-root-menu)
 225
 226 (bind-keys window-keymap
 227            "W-Space"         (lambda () (popup-window-menu (input-focus))))
 228
 229 (mapc
 230  (lambda (spec)
 231    (when (cdr spec)
 232      (bind-keys
 233       global-keymap
 234       (car spec)
 235       (let ((spec (cdr spec)))
 236         (if (listp spec)
 237             (lambda ()
 238               (display-window (apply mn-run-unless spec)))
 239           (lambda ()
 240             (mn-run spec)))))))
 241
 242  (let* ((home (getenv "HOME"))
 243         (libexec (concat home "/.local/libexec/"))
 244         (sh-maybe (lambda (dir fname #!optional args)
 245                     (let ((fname (concat dir fname)))
 246                       (if (file-exists-p fname)
 247                           (concat "/bin/sh " fname (or args "")))))))
 248    `(("W-;" "^Emacs/emacs$"  "e")
 249      ("W-." "/IRC$"          ,mn-irssi-command)
 250      ("W-a" "GIMP"           "gimp")
 251      ("W-o" "Geeqie"         "geeqie")
 252      ("Pause"               . ,(sh-maybe libexec "xlocker"))
 253      ("Scroll_Lock"         . ,(sh-maybe libexec "xlocker"))
 254      ("Print"               . ,(sh-maybe libexec "xlocker"))
 255      ("W-\""                . "m rewind")
 256      ("W-'"                 . "m prev")
 257      ("W-j"                 . "m toggle")
 258      ("W-k"                 . "m next")
 259      ("XF86Display"         . ,(sh-maybe home "/.xscreen-config"))
 260      ("XF86MonBrightnessUp"   . "xbacklight + 25")
 261      ("XF86MonBrightnessDown" . "xbacklight - 25"))))
 262
 263 (define (mn-get-browser-priority wnd)
 264   (let ((cls (get-x-text-property wnd 'WM_CLASS)))
 265     (when (> (length cls) 1)
 266       (catch 'return
 267         (mapc (lambda (spec)
 268                 (and (string= (car spec) (aref cls 0))
 269                      (or (not (cadr spec))
 270                          (string= (cadr spec) (aref cls 1)))
 271                      (throw 'return (cddr spec))))
 272               '(("Navigator"     "Firefox-esr" . 0)
 273                 ("Navigator"     "Firefox"     . 0)
 274                 ("opera"         ()            . 1)
 275                 ("chromium"      ()            . 2)
 276                 ("Google-chrome" ()            . 3)
 277                 ("Navigator"     ()            . 4)))))))
 278
 279 ;;; Looks for a web browser to select.  Switches to a window which currently
 280 ;;; doesn’t hold input focus prioritising windows as follows:
 281 ;;;
 282 ;;; * non-iconified windows are preferred over iconified windows,
 283 ;;; * windows visible on current view-port are preferred over other windows and
 284 ;;; * Firefox > Opera > Chromium > Chrome.
 285 ;;;
 286 ;;; If no browser window is found starts Firefox.
 287 (define (mn-get-browser)
 288   (let ((focused (input-focus))
 289         (best-pri 1000) best found-firefox)
 290     ;; If focused window is outside of current viewport pretend it’s not
 291     ;; focused.  This is needed if we switch to far away viewport while
 292     ;; retaining focus in a browser window.
 293     (when (window-outside-viewport-p focused)
 294       (setq focused nil))
 295     (map-windows
 296      (lambda (wnd)
 297        (let ((pri (mn-get-browser-priority wnd)))
 298          (when (= pri 0)
 299            (setq found-firefox t))
 300          (when (and pri
 301                     (not (and focused
 302                               (memq focused (transient-group wnd)))))
 303            (when (window-outside-viewport-p wnd) (setq pri (+ pri 10 )))
 304            (when (window-iconified-p        wnd) (setq pri (+ pri 100)))
 305            (when (< pri best-pri)
 306              (setq best-pri pri best wnd))))
 307        (/= best-pri 0)))
 308     (if best
 309         (display-window (or (last (transient-children best t)) best))
 310       (or found-firefox (mn-run "firefox")))))
 311
 312 (bind-keys global-keymap "W-," mn-get-browser)
 313
 314 ;;; Returns t if given window is a terminal window.  More specifically, whether
 315 ;;; window’s WM_CLASS is Term.
 316 (define (mpn-terminal-window-p wnd)
 317   (let ((cls (get-x-text-property wnd 'WM_CLASS)))
 318     (and cls (string-equal "Term" (aref cls 0)))))
 319
 320 ;;; Selects terminal window in current view-port or starts a terminal.
 321 ;;;
 322 ;;; Also warps mouse to the centre of the window if not already above it."
 323 (define (mn-get-term)
 324   (let ((terms (delete-if-not mpn-terminal-window-p
 325                               (window-order current-workspace t))))
 326     (if terms
 327         ;; If there are at least two terminal windows and the first one has
 328         ;; input focus, display the second one.  Otherwise, display the first
 329         ;; one.
 330         (display-window
 331          (or (and (eq (car terms) (input-focus)) (cadr terms)) (car terms)))
 332       ;; No terminal windows, start a new one.
 333       (mn-run xterm-program))))
 334
 335 (setq warp-to-window-enabled t
 336       warp-to-window-offset (cons 50 50))
 337
 338 (bind-keys global-keymap "W-$" mn-get-term)
 339
 340
 341 (require 'sawfish.wm.ext.run-application)
 342 (setq run-application:y-position 'top)
 343 (bind-keys global-keymap "W-r" 'run-application)
 344
 345 (let ((map (make-keymap))
 346       (make-cmd (lambda (cmd)
 347                   (lambda ()
 348                     (when (numberp cmd)
 349                       (setq cmd (format nil "Master %d%%" cmd)))
 350                     (mn-run (concat "amixer set " cmd))))))
 351   (let ((chars ";,.aoe'qjk") (i 0) ch)
 352     (while (< i (length chars))
 353       (setq ch (aref chars i) i (1+ i))
 354       (bind-keys map
 355                  (concat ""   ch) (make-cmd (- (* i 10) 5))
 356                  (concat "W-" ch) (make-cmd (* i 10)))))
 357   (bind-keys map
 358              "W-p" (make-cmd "Master toggle")
 359              "u"   (make-cmd "Master 70%")
 360              "W-u" (make-cmd "Master 50%"))
 361   (bind-keys global-keymap
 362              "W-u" map
 363              "XF86AudioLowerVolume" (make-cmd "Master 10%-")
 364              "XF86AudioRaiseVolume" (make-cmd "Master 10%+")
 365              "XF86AudioMute"        (make-cmd "Master toggle")
 366              "XF86AudioMicMute"     (make-cmd "Capture toggle")))
 367
 368 ; Having Super-Tab bound seems to overwrite existing W-Tab binding.
 369 ; cabinet-switch is nice and all, but having it under W-Tab is not what I want.
 370 ; Unbind Super-Tab to get cycle-windows back.
 371 (unbind-keys global-keymap "Super-Tab")
 372 ; Also unbind C-Tab since this is used for switching tabs in a browser.
 373 (unbind-keys global-keymap "C-Tab")
 374
 375 ;; Window manipulations
 376 (bind-keys window-keymap
 377            ;; Move to an edge
 378            "W-c"   'pack-window-up
 379            "W-t"   'pack-window-down
 380            "W-h"   'pack-window-left
 381            "W-n"   'pack-window-right
 382            ;; Grow to an edge
 383            "W-C"   'grow-window-up
 384            "W-T"   'grow-window-down
 385            "W-H"   'grow-window-left
 386            "W-N"   'grow-window-right
 387            ;; Shrink till it overlaps with one less window
 388            "C-W-c" 'shrink-window-up
 389            "C-W-t" 'shrink-window-down
 390            "C-W-h" 'shrink-window-left
 391            "C-W-n" 'shrink-window-right
 392            ;; Move till it overlaps with one less window
 393            "C-W-C" 'yank-window-up
 394            "C-W-T" 'yank-window-down
 395            "C-W-H" 'yank-window-left
 396            "C-W-N" 'yank-window-right)
 397
 398
 399 ;; Run some applications
 400 (add-hook 'after-initialization-hook
 401           (lambda ()
 402             (let ((sn (system-name)))
 403               (mapc
 404                (lambda (spec)
 405                  (when (string-looking-at (car spec) sn)
 406                    (apply mn-run-unless (cdr spec))))
 407                `((""                  "^Emacs/emacs$" "e")
 408                  ("erwin|pikus"       "/IRC$"         ,mn-irssi-command)
 409                  ("erwin"             "/MPD$"         ,mn-mpdshow-command)))
 410             (set-screen-viewport 0 0))))
 411
 412 ;;}}}
 413
 414 ;; Desktop background
 415
 416 (let ((set-bg-script (concat (getenv "HOME") "/.local/libexec/set-bg")))
 417   (when (file-exists-p set-bg-script)
 418     (require 'rep.io.timers)
 419
 420     (define set-bg--timer (make-timer (lambda (_) (set-bg))))
 421
 422     (define (set-bg--state-func proc)
 423       (set-timer set-bg--timer (if (= (process-exit-value proc) 0) 900 10)))
 424
 425     (define (set-bg)
 426       (delete-timer set-bg--timer)
 427       (start-process (let ((proc (make-process)))
 428                        (set-process-output-stream proc standard-output)
 429                        (set-process-error-stream proc standard-error)
 430                        (set-process-function proc set-bg--state-func)
 431                        (set-process-dir proc "/")
 432                        (set-process-prog proc set-bg-script)
 433                        proc))
 434       ())
 435
 436     (set-bg)
 437     (set-hook 'randr-change-notify-hook set-bg)
 438     (bind-keys root-window-keymap "Button1-Click2" set-bg)))
 439
 440 ;;{{{ Matcher
 441
 442 (define-frame-type-mapper
 443   (lambda (wnd type)
 444     (if (window-transient-p wnd)
 445         type
 446       'unframed)))
 447
 448 (require 'sawfish.wm.ext.match-window)
 449
 450 (define-match-window-setter 'location
 451   (lambda (wnd prop value)
 452     (declare (unused prop))
 453     (let ((x (nth 0 value)) (y (nth 1 value))
 454           (w (nth 2 value)) (h (nth 3 value))
 455           (v (nth 4 value)))
 456       ; Position
 457       (when (and x y)
 458         (when (< x 0) (setq x (+ (screen-width ) x)))
 459         (when (< y 0) (setq y (+ (screen-height) y)))
 460         (window-put wnd 'ignore-program-position #t)
 461         (move-window-to wnd x y))
 462       ; Dimensions
 463       (when (and w h)
 464         (resize-window-with-hints wnd w h))
 465       ; Viewport (maybe)
 466       (when v
 467         (set-screen-viewport     (1- v) 0)
 468         (set-window-viewport wnd (1- v) 0))
 469       ; Maximize (maybe)
 470       (when (and x w (= x 0) (= w (screen-width)))
 471         (window-put wnd 'queued-horizontal-maximize #t))
 472       (when (and y h (= y 0) (= h (screen-height)))
 473         (window-put wnd 'queued-horizontal-maximize #t)))))
 474
 475 ;; (define-match-window-matcher 'screen
 476 ;;   (lambda (w _prop value)
 477 ;;     (and (let ((w) (car value)) (or (not w) (= (screen-width ) w)))
 478 ;;          (let ((h) (car value)) (or (not h) (= (screen-height) h))))))
 479
 480
 481 (let ((match-screen (lambda (_wnd width height)
 482                       (and (or (eq t width)
 483                                (= width (screen-width)))
 484                            (or (eq t height)
 485                                (= height (screen-height))))))
 486       (first-term-p (lambda (wnd)
 487                       (and (mpn-terminal-window-p wnd)
 488                            (do ((wnds (managed-windows) (cdr wnds)))
 489                                ((or (null wnds)
 490                                     (and (not (eq (car wnds) wnd))
 491                                          (mpn-terminal-window-p (car wnds))))
 492                                 (null wnds)))))))
 493   (setq match-window-profile
 494         (apply nconc
 495                (mapcar
 496                 (lambda (profile-set)
 497                   (when (stringp (caar profile-set))
 498                     (setcar (car profile-set)
 499                             (cons 'WM_CLASS (caar profile-set))))
 500                   (mapcar (lambda (profile)
 501                             (let ((matches (car profile-set)))
 502                               (when (or (numberp (car profile))
 503                                         (eq t (car profile)))
 504                                 (setq matches (cons (list match-screen
 505                                                           (car profile)
 506                                                           (cadr profile))
 507                                                     matches)
 508                                       profile (cddr profile)))
 509                               (cons matches profile)))
 510                           (cdr profile-set)))
 511                 `((("^Emacs/emacs$")
 512                    (4160 2560  (location  136    0  1464 2560  1)))
 513
 514                   (((,first-term-p))
 515                    (4160 2560  (location 1600    0   906 1440)))
 516
 517                   (("^Firefox(-esr)?/Navigator$")
 518                    (4160 2560  (location 2506    0  1654 1440  1)))
 519
 520                   (("^MPlayer/|^mpv/|^openttd/|^Inkscape/|^[Vv]irt-manager/|^gzdoom/")
 521                    (           (alpha 1 . 1)))
 522                   (("^Gimp/|^Inkscape/")
 523                    (           (alpha 1 . 0.7)))
 524
 525                   ;; GIMP
 526                   (("^Gimp/gimp$" (WM_WINDOW_ROLE . "^gimp-[^s]"))
 527                    (           (viewport 2 . 1) (group . Gimp)))
 528
 529                   (("^Gimp/gimp$" (WM_WINDOW_ROLE . "^gimp-startup$"))
 530                    (           (place-mode . centered) (depth . 16)
 531                                (never-focus . #t) (focus-when-mapped . #f)
 532                                (sticky-and-skip . #t)))
 533
 534                   ;; Geeqie
 535                   (((WM_ICON_NAME . "Geeqie$"))
 536                    (           (viewport 3 . 1) (alpha 1 . 1))))))))
 537
 538 ;;}}}
 539
 540 ; (restart)