;;
;; .sawfishrc -- Sawfish window manager configuration file
;; Copyright 2008 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/>.
;;
 
;;{{{ What machine are we running
 
(defvar mn-machine
  (catch 'return
    (let ((sn (system-name)))
      (mapc (lambda (spec)
              (when (string-looking-at (car spec) sn)
                (throw 'return (cdr spec))))
            '(("erwin"     . erwin)
              ("tuptus"    . tuptus)
              ("pikus"     . pikus))))))
 
(defun mn-val-filter (value #!rest list)
  (mapcar cdr (filter (lambda (element)
                        (let ((a (car element)))
                          (cond
                           ((not a)           t)
                           ((not (listp a))   (equal value a))
                           ((= (car a) 'eval) (eval (cdr a)))
                           (t                 (member value a)))))
                      list)))
 
(defun case-equal (value #!rest list)
  (while (and list (not (member value (caar list))))
    (setq list (cdr list)))
  (and list (cadar list)))
 
 
(defun screen-size ()
  "Screen resolution formatted as WIDTHxHEIGHT."
  (concat (number->string (screen-width)) "x" (number->string (screen-height))))
 
;;}}}
;;{{{ Misc small
 
;; Show errors on screen
(require 'sawfish.wm.ext.error-handler)
(setq error-destination 'screen)
 
 
;; Hyper (win key) as prefix
(custom-set-typed-variable
 (quote wm-modifier-value) (quote (hyper)) (quote modifier-list))
 
 
;; Focus and Auto Raise
(require 'auto-raise)
(setq focus-mode             'enter-only
      focus-click-through    t
      raise-windows-on-focus t
      raise-window-timeout   200)
(bind-keys window-keymap
           "W-Button2-Click"(lambda () (raise-lower-window   (input-focus))))
 
 
;; 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-Button1-Move" (lambda()(move-window-interactively  (input-focus)))
           "W-Button3-Move" (lambda()(resize-window-interactively(input-focus))))
 
 
;; No decoration
(add-hook 'before-add-window-hook
          (lambda (w)
            (unless (window-transient-p w)
              (set-window-type w 'unframed))))
 
;;}}}
;;{{{ Viewports
 
(set-number-of-viewports 10 1)
(set-screen-viewport 0 0)
 
(bind-keys global-keymap
           "W-F1"           (lambda () (set-screen-viewport 0 0))
           "W-F2"           (lambda () (set-screen-viewport 1 0))
           "W-F3"           (lambda () (set-screen-viewport 2 0))
           "W-F4"           (lambda () (set-screen-viewport 3 0))
           "W-F5"           (lambda () (set-screen-viewport 4 0))
           "W-F6"           (lambda () (set-screen-viewport 5 0))
           "W-F7"           (lambda () (set-screen-viewport 6 0))
           "W-F8"           (lambda () (set-screen-viewport 7 0))
           "W-F9"           (lambda () (set-screen-viewport 8 0))
           "W-F9"           (lambda () (set-screen-viewport 9 0)))
 
(defmacro set-current-window-viewport-x-0 (x)
  (list 'lambda nil (list 'set-window-viewport (list 'input-focus) x '0)))
 
(bind-keys window-keymap
           "W-1"            (set-current-window-viewport-x-0 0)
           "W-2"            (set-current-window-viewport-x-0 1)
           "W-3"            (set-current-window-viewport-x-0 2)
           "W-4"            (set-current-window-viewport-x-0 3)
           "W-5"            (set-current-window-viewport-x-0 4)
           "W-6"            (set-current-window-viewport-x-0 5)
           "W-7"            (set-current-window-viewport-x-0 6)
           "W-8"            (set-current-window-viewport-x-0 7)
           "W-9"            (set-current-window-viewport-x-0 8)
           "W-0"            (set-current-window-viewport-x-0 9))
 
;;}}}
;;{{{ Transparency
 
(defvar 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] multiplies 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-property (w)
          (or (window-get w 'alpha) default-window-alpha))
 
;; Sets window opacity.
;; If alpha is nil uses `window-alpha-property'.
;; Uses `window-alpha-value' to get alpha value from alpha and blur arguments.
(defun set-window-alpha (w alpha #!optional blur)
  (let ((a (window-alpha-value (or alpha (window-alpha-property w)) blur)))
    (if (= a window-alpha-max)
        (delete-x-property (window-frame-id w) '_NET_WM_WINDOW_OPACITY))
    (set-x-property (window-frame-id w) '_NET_WM_WINDOW_OPACITY
                    (make-vector 1 a) 'CARDINAL 32))
  (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  )))
 
;;}}}
;;{{{ Applications & menus
 
(require 'menus)
(require 'customize)
 
(defvar mn-term-command
  (case-equal (screen-size)
    '(("1680x1050") "term -N Term -g 80x32")
    '(("1024x768" ) "term -N Term -g 80x25")
    '(("1600x1200") "term -N Term -g 80x35")
    '(("1200x1600") "term -N Term -g 80x45")))
(defvar mn-mpdshow-command
  (when (= mn-machine 'erwin)
    "term -N MPD -mesg -g 80x1-68+0 -e mpd-show -c80"))
(defvar mn-irssi-command
  (case-equal (screen-size)
    '(("1680x1050") "term -N IRC -mesg -g 80x10-68+10  -e irssi")
    '(("1024x768" ) "term -N IRC -mesg -g 80x10-64+0   -e irssi")
    '(("1600x1200") "term -N IRC -mesg -g 80x10-72+0   -e irssi")
    '(("1200x1600") "term -N IRC -mesg -g 80x10-72+0   -e irssi")))
 
 
;; Jump to term or exec
(require 'sawfish.wm.util.window-order)
(defun mn-term-or-exec ()
  (let ((windows
         (filter
          (lambda (w)
            (and (not (window-get w 'sticky))
                 (string-match "xterm|u?rxvt|Term"
                               (aref (get-x-text-property w 'WM_CLASS) 0))))
          (window-order current-workspace t nil))))
    (if windows
        (display-window (car windows))
      (system (concat mn-term-command " &")))))
 
;; Inspired by jump-or-exec written by Damien Elmes <resolve@repose.cx>
(defun mn-jump-or-exec (regexp command)
  (let ((w (get-window-by-name-re regexp)))
    (if w (display-window w) (system (concat command " &")))))
 
;; Menus
(setq apps-menu
      '(("_irssi"     (mn-jump-or-exec "^IRC$"     mn-irssi-command))
        ("_Emacs"     (mn-jump-or-exec "^Emacs"   "emacs"))
        ("The _GIMP"  (mn-jump-or-exec "^GIMP$"   "gimp"))
        ("GQ_View"    (mn-jump-or-exec "^GQview$" "gqview"))
        ("_Opera"     (mn-jump-or-exec "Opera$"   "opera")))
      root-menu
      (nconc
       '(("_Customize" customize)
         ("Re_start"   restart)
         ()
         ("_Quit"      quit)
         ("_Reboot"    (progn (system "( sleep 2; /sbin/reboot )") (quit))))
       (and (file-exists-p "/usr/local/sbin/reboot-w")
            '(("Reboot _Windows"
               (progn (system "( sleep 2; /usr/local/sbin/reboot-w )") (quit)))))
       '(("Power _Off" (progn (system "( sleep 2; /sbin/halt   )") (quit))))))
 
 
;; Application and menu bindings
(bind-keys root-window-keymap
           "Button1-Click2" (lambda () (system (concat mn-term-command " &")))
           "Button2-Click"  (lambda () (popup-menu window-menu))
           "Button3-Click"  popup-apps-menu
           "W-Space"        popup-apps-menu
           "W-Button3-Click"popup-root-menu)
 
(bind-keys global-keymap
           "W-`"           mn-term-or-exec
           "W-q"           (lambda()(mn-jump-or-exec "^Emacs"   "emacs"))
           "W-w"           (lambda()(mn-jump-or-exec "Opera$"   "opera"))
           "W-e"           (lambda()(mn-jump-or-exec "^IRC$"     mn-irssi-command))
           "W-r"           (lambda()(mn-jump-or-exec "^GIMP$"   "gimp"))
           "W-t"           (lambda()(mn-jump-or-exec "^GQview$" "gqview")))
 
(bind-keys window-keymap
           "W-Space"        (lambda () (popup-window-menu (input-focus))))
;; (bind-keys window-keymap
;;            "W-Button3-Click"(lambda () (popup-window-menu (input-focus))))
 
 
;; Run some applications
(add-hook 'after-initialization-hook
          (lambda ()
            (mapc (lambda (pair)
                    (unless (and (car pair)(get-window-by-name-re (car pair)))
                      (system (concat (cdr pair) " &"))))
                  (mn-val-filter mn-machine
                   '((erwin pikus)       "Opera"    . "opera")
                   '((erwin pikus)       "Emacs"    . "emacs")
                   `((erwin pikus)       "IRC"      . ,mn-irssi-command)
                   `((eval . mn-mpdshow-command)
                                         "mpdshow"  . ,mn-mpdshow-command)
                   '(()                  "gkrellm"  . "gkrellm")))
            (set-screen-viewport 0 0)))
 
;;}}}
;;{{{ Music Player Daemon
 
(when (member mn-machine '(erwin tuptus pikus))
  (when (and (= mn-machine 'tuptus) (not (getenv "MPD_HOST")))
    (setenv "MPD_HOST" "erwin"))
 
  (if (eq mn-machine 'pikus)
      (defun mn-mpd (command)
        (system
         (concat "echo '" command
                 "\nclose\n' | nc ${MPD_HOST-localhost} ${MPD_PORT-6600} >/dev/null")))
    (defun mn-mpd (command)
      (system
       (concat "echo '" command
               "\nclose\n' >/dev/tcp/${MPD_HOST-localhost}/${MPD_PORT-6600}"))))
 
 
  (defmacro mn-mpd-lambda (command)
    (list 'lambda () (list 'mn-mpd command)))
 
  (bind-keys global-keymap
             "W-z"            (mn-mpd-lambda "previous")
             "W-x"            (mn-mpd-lambda "play")
             "W-c"            (mn-mpd-lambda "pause")
;             "W-v"            (mn-mpd-lambda "stop")
             "W-v"            (mn-mpd-lambda "next")))
 
;;}}}
;;{{{ Matcher
 
(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-setter 'sticky-and-skip
  (lambda (w prop value)
    (declare (unused prop))
    (mapc (lambda (prp) (window-put w prp value))
          '(sticky sticky-viewport cycle-skip window-list-skip task-list-skip))))
 
(setq match-window-profile
      (mn-val-filter (screen-size)
       '(()            ((WM_CLASS . "/MPD$"))
                       (focus-when-mapped . #f) (focus-mode . click)
                       (sticky-and-skip . #t))
 
       '(()            ((WM_CLASS . "/IRC$"))
                       (sticky . #t) (sticky-viewport . #t))
 
       '(("1680x1050") ((WM_CLASS . "^Opera/opera$"))
                       (location  500  350   1179  700  1))
       '(("1024x768" ) ((WM_CLASS . "^Opera/opera$"))
                       (location    0  368   1024  400  1))
       '(("1600x1200") ((WM_CLASS . "^Opera/opera$"))
                       (location  600  500   1000  700  1))
       '(("1200x1600") ((WM_CLASS . "^Opera/opera$"))
                       (location    0    0   1200 1600  2))
 
       '(("1680x1050") ((WM_CLASS . "^Emacs"))
                       (location    0    0     80  105  1) (maximize . vertical))
       '(("1024x768" ) ((WM_CLASS . "^Emacs"))
                       (location    0    0     80   76  1) (maximize . vertical))
       '(("1600x1200") ((WM_CLASS . "^Emacs"))
                       (location    0    0     80   80  1) (maximize . vertical))
       '(("1200x1600") ((WM_CLASS . "^Emacs"))
                       (location    0    0     80  123  1) (maximize . vertical))
 
       ; rxvt-unicode ignores geometry's potition when tabbed is enabled
       ; so sawfish must fix that
       '(("1680x1050") ((WM_CLASS . "/Term$")) (position 500 .   0))
       '(("1024x768" ) ((WM_CLASS . "/Term$")) (position 480 . 100))
       '(("1600x1200") ((WM_CLASS . "/Term$")) (position 492 .   0))
       '(("1200x1600") ((WM_CLASS . "/Term$")) (position 650 . 100))
 
       '(()            ((WM_CLASS . "^Gimp/gimp|MPlayer/.*|openttd/openttd$"))
                       (alpha . 1))
 
       '(()            ((WM_CLASS . "^Gimp/gimp$") (WM_WINDOW_ROLE . "^gimp-[^s]"))
                       (viewport 2 . 1) (group . Gimp))
       '(("1200x1600") ((WM_CLASS . "^Gimp/gimp$") (WM_WINDOW_ROLE . "^gimp-[^s]"))
                       (viewport 3 . 1))
       '(()            ((WM_CLASS . "^Gimp/gimp$") (WM_WINDOW_ROLE . "^gimp-startup$"))
                       (place-mode . centered) (depth . 16)
                       (focus-when-mapped . #f) (never-focus . #t)
                       (sticky-and-skip . #t))
 
       '(()            ((WM_ICON_NAME . "^GQview$"))
                       (viewport 3 . 1))
       '(("1200x1600") ((WM_ICON_NAME . "^GQview$"))
                       (viewport 4 . 1))))
 
;;}}}
 
; (restart)