;;; dot.sawfishrc --- sawfish configuration file

;; Author: Mark Triggs <mst@dishevelled.net>
;; Time-stamp: "2004-03-07 00:48:57 mst"

;; This file 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 2, or (at your option) any
;; later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Code:

(setq load-path (append
                 (list (concat (getenv "HOME") "/" ".sawfish/site-lisp/"))
                 (list (concat (getenv "HOME") "/" ".sawfish/homebrew/"))
                 (list (concat (getenv "HOME") "/" ".sawfish/dist/"))
                 load-path))

(require 'sawfish-homebrew)             ; my custom functions
(require 'sawfish.wm.util.prompt)
(require 'macros)
(require 'selection-push)
(require 'smart-tile)

(when (string-match "mozart" (system-name))
  (require 'battery))

;;;; User Settings

(setq meta-key "Super")

(setq mst-windows-on-own-workspace '("Term$" "Mozilla" "MGT"))
(setq notify-progs '("emacs" "mozilla" "gnome-terminal" "xterm" "wterm"
                     "multi-gnome-terminal"))

;; Theme
(if (member 'rmDarkCalamari (find-all-frame-styles))
    (setq default-frame-style 'rmDarkCalamari)
  (setq default-frame-style 'brushed-metal))

(setq focus-mode 'click
      raise-windows-on-focus t
      move-snap-epsilon 12
      tooltips-enabled nil
      place-window-mode 'centered
      move-show-position t
      move-lock-when-maximized nil
      workspace-boundary-mode 'stop)


(defun jump-or-exec-available (&rest programs)
  "Take lists of the form (commandline regexp onfocus) and either
execute the first available commandline, jump to a window associated with a
program that is already running or call the function onfocus if it was given"
  (let* ((entry (find-if (lambda (e) (program-available (car e)))
                         (mapcar (lambda (e)
                                   (cons (car (string-split " " (car e)))
                                         e))
                                 programs))))
    (destructuring-bind (cmdline regexp onfocus) (cdr entry)
      (if (and regexp (get-window-by-name-re regexp))
          (if (equal (get-window-by-name-re regexp) (input-focus))
              (if onfocus
                  (onfocus (input-focus))
                (system cmdline))
            (display-window (get-window-by-name-re regexp)))
        (system cmdline)))))


;;;; Functions to call commonly used programs
(defun terminal ()
  "Find and run a suitable terminal program"
  (jump-or-exec-available
   `("wterm -bg black -title Term -fg white -tn xterm -e screen -R &" "Term$"
     ,(lambda (w)
        (synthesize-event "C-q" (input-focus))
        (sleep-for 0.2)
        (synthesize-event "C-c" (input-focus))))
   `("aterm -e screen &")
   `("xterm -bg black -fg white -e screen &")))


(defun browser ()
  "Find and run a browser"
  (jump-or-exec-available
   `("mozilla &" "Mozilla" ,(lambda (w) nil)))
   `("galeon &" "galeon" ,(lambda () (system "/usr/bin/galeon -n &")))
   '("netscape &" nil nil))


;;;; Mouse menus
(defvar root-menu nil)
(setq root-menu
      '(("Programs" . apps-menu)
        ()
        ("Restart Sawfish" restart)
        ("Logout" quit)))

(defvar apps-menu nil)
(setq apps-menu
      `(("Terminal" (terminal))
        ("Browser" (browser))))


;;;; Keymaps ;;;;

;; new fangled emacs terminal
(bind-keys global-keymap (meta+ "t")
           (lambda ()
             (let ((emacs (get-window-by-class-re "^Emacs")))
               (cond ((equal (input-focus) emacs)
                      (synthesize-event "C-c" emacs)
                      (synthesize-event "t" emacs))
                     (t (display-window emacs)
                        (unless (string-match "terminal" (window-name emacs))
                          (synthesize-event "C-c" emacs)
                          (synthesize-event "t" emacs)))))))

;; Global ;;
(bind-keys global-keymap (meta+ "n")
		   '(system "sleep 2; xset dpms force off & xscreensaver-command -lock &"))
(bind-keys global-keymap "Menu" '(system "xscreensaver-command -lock &"))
(bind-keys global-keymap (meta+ "d") 'delete-window)
(bind-keys global-keymap (meta+ "D") 'destroy-window)
(bind-keys global-keymap (meta+ "c")
           '(system "xterm -e ~/.bin/checkspell $(xclip -o) &"))

(bind-keys global-keymap (meta+ "j")
           (lambda ()
             (let* ((wind (get-window-by-name-re ".*XMMS.*"))
                    (old-workspace (window-workspace wind)))
               (select-workspace old-workspace)
               (synthesize-event "j" wind))))

(bind-keys global-keymap (meta+ "`")
           (lambda ()
	     (when (get-window-by-class-re "^Emacs")
               (synthesize-event "M-F1" (get-window-by-class-re "^Emacs")))
             (display-window (get-window-by-class-re "^Emacs"))))

(bind-keys global-keymap (meta+ "q")
           (lambda ()
	     (when (get-window-by-class-re "^Emacs")
               (synthesize-event "M-F2" (get-window-by-class-re "^Emacs")))
             (display-window (get-window-by-class-re "^Emacs"))))

(bind-keys global-keymap (meta+ "e")
           (lambda ()
	     (when (get-window-by-class-re "^Emacs")
               (synthesize-event "M-F3" (get-window-by-class-re "^Emacs")))
             (display-window (get-window-by-class-re "^Emacs"))))

(bind-keys global-keymap (meta+ "~") '(system "emacs &"))

(bind-keys global-keymap (meta+ "a") '(display-window (get-window-by-name-re
                                                       "\.\(pdf\|PDF\)$")))

(when (string-match "mozart" (system-name))
  (setq fan 0)
  (bind-keys global-keymap (meta+ "f") (lambda ()
                                         (setq fan (mod (+ fan 1) 3))
                                         (system (format nil "i8kfan %s %s"
                                                         fan fan)))))
(bind-keys global-keymap (meta+ "F")
           '(system "fetchmail -q; fetchmail -d 120"))
(bind-keys global-keymap (meta+ "g") '(browser))
(bind-keys global-keymap (meta+ "m") '(system "music &"))
(bind-keys global-keymap (meta+ "p")
           '(system "wterm -geometry 120x35 -e playlist &"))
(bind-keys global-keymap (meta+ "Q") '(system "gnus &"))
(bind-keys global-keymap (meta+ "r") '(waffle))

(bind-keys global-keymap (meta+ "w") '(terminal))

(bind-keys global-keymap (meta+ "0") '(select-workspace (find-free-workspace)))
(bind-keys global-keymap (meta+ "x") '(system "xterm -fg white -bg black &"))

(bind-keys global-keymap (meta+ "F1") '(run-shell-command "xmms -r"))
(bind-keys global-keymap (meta+ "F2") '(run-shell-command "xmms -s"))
(bind-keys global-keymap (meta+ "F3") '(run-shell-command "xmms -p"))
(bind-keys global-keymap (meta+ "F4") '(run-shell-command "xmms -f"))
(bind-keys global-keymap (meta+ "F5")
           '(run-shell-command "xmms-shell -e \"shuffle toggle\""))
(bind-keys global-keymap (meta+ "F6")
           '(run-shell-command "xmms-shell -e \"fade 0;stop;play\";xmms -f"))
(bind-keys global-keymap (meta+ "F7")
           '(run-shell-command "xmms-shell -e pause"))
(bind-keys global-keymap (meta+ "F8")
           '(run-shell-command
             (concat "xmms-shell -e status | head -2 | cut -d':' -f2- | xargs"
                     "| osd_cat -c \"\"#ffffff "
                     "-f \"-monotype-times new roman-bold-r-normal--"
                     "22-160-100-100-p-94-iso8859-1\" -d2 -b -o 60")))
(bind-keys global-keymap "F13" '(run-shell-command "soundscript pause"))
(bind-keys global-keymap "F14" '(run-shell-command "xmms -s"))
(bind-keys global-keymap "F15" '(run-shell-command "xmms -r"))
(bind-keys global-keymap "F16" '(run-shell-command "xmms -f"))
(bind-keys global-keymap "F17" '(run-shell-command "amixer -q set PCM 5%-"))
(bind-keys global-keymap "F18" '(run-shell-command "amixer -q set PCM 5%+"))
(bind-keys global-keymap "F24" '(run-shell-command "soundscript mute"))
(bind-keys global-keymap (meta+ "+") '(system "eject -t /dev/dvd &"))
(bind-keys global-keymap (meta+ ",") '(run-shell-command "xmms -r"))
(bind-keys global-keymap (meta+ "-") '(system "eject /dev/cdroms/cdrom1 &" t))
(bind-keys global-keymap (meta+ ".") '(run-shell-command "xmms -f"))
(bind-keys global-keymap (meta+ "=") '(system "eject  /dev/dvd &"))
(bind-keys global-keymap (meta+ "TAB") 'cycle-windows)
(bind-keys global-keymap (meta+ "_") '(system "eject -t /dev/cdroms/cdrom0 &"))

;; volume control
(bind-keys global-keymap (meta+ "]") '(system "aumix -w +5 &"))
(bind-keys global-keymap (meta+ "[") '(system "aumix -w -5 &"))

(bind-keys global-keymap (meta+ "!") '(moz-to-w3m))


(bind-keys global-keymap "S-C-F11" 'popup-window-list)
(bind-keys global-keymap (meta+ "esc") 'popup-root-menu)
(bind-keys global-keymap (meta+ "s") 'toggle-window-sticky)

;; workspaces
(do ((i 1 (1+ i)))
    ((> i 9))
  (bind-keys global-keymap (meta+ (format nil "%s" i))
             `(activate-workspace ,i)))

(bind-keys global-keymap (meta+ "Right") 'next-workspace)
(bind-keys global-keymap (meta+ "Left") 'previous-workspace)

(bind-keys global-keymap (meta+ "b") '(battery))

;; Window ;;
(bind-keys window-keymap "C-ESC" 'popup-window-menu)
(bind-keys window-keymap (meta+ "Button1-Click") 'move-window-interactively)
(bind-keys window-keymap (meta+ "Button3-Click") 'resize-window-interactively)
(bind-keys window-keymap (meta+ "Down")
           (lambda () (lower-window-depth (input-focus))))
(bind-keys window-keymap (meta+ "F10") 'maximize-window-toggle)
(bind-keys window-keymap (meta+ "F9") 'toggle-window-shaded)
(bind-keys window-keymap (meta+ "Up")
           (lambda () (raise-window-depth (input-focus))))


;; Titlebar ;;
(bind-keys title-keymap "Button1-Move" 'move-window-interactively)
(bind-keys title-keymap "Button1-Off2" 'toggle-window-shaded)
(bind-keys title-keymap "Button2-Move" 'resize-window-interactively)
(bind-keys title-keymap "Button3-Click" 'popup-window-menu)
(bind-keys title-keymap "Button3-Off" 'raise-lower-window)

(bind-keys global-keymap (meta+ "F11") 'tile-windows)

(defvar *once-hooks* '())

(defun do-once (hook name fn)
  (let ((new-fn (lambda (&rest args)
                  (apply fn args)
                  (remove-hook hook (cdr (assoc name *once-hooks*)))
                  (setq *once-hooks*
                        (remove (assoc name *once-hooks*) *once-hooks*)))))
    (setq *once-hooks* (cons (cons name new-fn) *once-hooks*))
    (add-hook hook new-fn t)))

;; Open an emacs frame on the current workspace and tile all windows.
(bind-keys global-keymap (meta+ "\\")
           (lambda ()
             (do-once 'after-add-window-hook
                      'tile-emacs
                      (lambda () (tile-windows)))
             (let ((emacs (get-window-by-class-re "^Emacs")))
               (synthesize-event "C-x" emacs)
               (synthesize-event "5" emacs)
               (synthesize-event "2" emacs))))


;;; hack to fix focus troubles with some applications
(require 'sawfish.wm.util.window-order)
(add-hook 'destroy-notify-hook window-order-focus-most-recent)

(bind-keys global-keymap (meta+ "Prior")
           '(synthesize-event "Button4-Click" (input-focus)))
(bind-keys global-keymap (meta+ "Next")
           '(synthesize-event "Button5-Click" (input-focus)))

;; Emacs style M-( binding in other apps. I think I'm addicted.
(bind-keys global-keymap "M-("
           (lambda ()
             (if (string-match "^Emacs" (window-class (input-focus)))
                 (synthesize-event "M-(" (input-focus))
               (mapc (lambda (e) (synthesize-event e (input-focus)))
                     '("(" ")" "Left")))))

;; DWIM scrolling for Firefox and acroread
(bind-keys global-keymap "C-v"
           (lambda ()
             (cond ((string-match "Firefox" (window-name (input-focus)))
                    (refocus-firebird)
                    (synthesize-event "SPC" (input-focus)))
                   ((eq (input-focus) (get-window-by-class-re "Acro"))
                    (synthesize-event "Next" (input-focus)))
                   (t (synthesize-event "C-v" (input-focus))))))

(bind-keys global-keymap "M-v"
           (lambda ()
             (cond ((string-match "Firefox" (window-name (input-focus)))
                    (refocus-firebird)
                    (synthesize-event "S-SPC" (input-focus)))
                   ((eq (input-focus) (get-window-by-class-re "Acro"))
                    (synthesize-event "Prior" (input-focus)))
                   (t (synthesize-event "M-v" (input-focus))))))

;;; Utilities
(defun find-if (fn l)
  (cond ((null l) nil)
        ((fn (car l)) (car l))
        (t (find-if fn (cdr l)))))

(defun program-available (cmd)
  "Returns true if a program named CMD can be found in the current path"
  (some (lambda (dir)
          (file-exists-p (concat dir "/" cmd)))
        (string-split ":" (getenv "PATH"))))

(defmacro destructuring-bind (vars valueform &rest body)
  `(apply (lambda ,vars ,@body)
          ,valueform))
