;;; -*- coding: utf-8; fill-column: 80 -*-
(when (or (featurep 'xemacs)
          (< emacs-major-version 23)
          (not (eq system-type 'gnu/linux)))
  (error "%s: not tested on this platform" load-file-name))

;;; Lightweight Debian integration of non-Debianized Emacsen.
;;; This solution is far from perfect.
(unless (boundp 'debian-emacs-flavor)
  (when (load "debian-startup" t)
    (defconst debian-emacs-flavor 'emacs)
    (debian-run-directories "/etc/emacs/site-start.d")))

(let ((default-directory "~/.emacs.d/lisp/"))
  (when (file-accessible-directory-p ".")
    (add-to-list 'load-path (expand-file-name "."))
    (mapc (lambda (x)
            (when (file-accessible-directory-p x)
              (add-to-list 'load-path (expand-file-name x))))
          (cons (int-to-string emacs-major-version)
                (directory-files "." nil "\\`[a-z][a-z0-9-]*\\'")))))

;;; Manually manage .emacs.d/lisp autoloads for now.
(mapc (lambda (x)
        (when (locate-library (car x))
          (mapc (lambda (y)
                  (autoload y (car x) nil t))
                (cdr x))))
      '(("darcsum" darcsum-whatsnew)
        ("inf-haskell" run-haskell switch-to-haskell)
        ("haskell-mode" haskell-mode literate-haskell-mode)
        ("haskell-cabal" haskell-cabal-mode)
        ("hyperspec" hyperspec-lookup hyperspec-lookup-format)
        ("paredit" enable-paredit-mode paredit-mode)
        ("quip" quip-mode)
        ("rst" rst-mode)
        ("scheme48" scheme48-mode)
        ("slime" slime slime-connet slime-mode)
        ("w3m" w3m w3m-browse-url w3m-find-file)))

(random t)
(unless (file-accessible-directory-p "~/.emacs.d")
  (make-directory-internal "~/.emacs.d"))

;;; settings
(setq-default fill-column 70
              indent-tabs-mode nil
              show-trailing-whitespace t
              save-place t)
(setq
 ;; global settings
 comment-style 'indent
 default-input-method 'TeX
 frame-title-format `((:eval (or (and (eq major-mode 'rcirc-mode)
                                      rcirc-target)
                                 (and (eq major-mode 'w3m-mode)
                                      (replace-regexp-in-string ; truncate title
                                       "\\s-+[-–—|]\\s-.*" ""
                                       (w3m-modeline-title)))
                                 (and (eq major-mode 'Info-mode)
                                      Info-current-node)
                                 (and (or (eq major-mode 'gnus-summary-mode)
                                          (eq major-mode 'gnus-article-mode))
                                      gnus-newsgroup-name
                                      (gnus-short-group-name
                                       (gnus-mode-string-quote
                                        (gnus-group-decoded-name
                                         gnus-newsgroup-name))))
                                 "%b"))
                      ,@(when window-system '(" - Emacs")))
 inhibit-startup-message t
 initial-major-mode 'fundamental-mode   ; don't load paredit for *scratch*
 mode-line-frame-identification nil
 require-final-newline t
 user-mail-address (getenv "EMAIL")
 version-control t
 x-select-enable-clipboard t            ; firefox cut-and-paste

 ;; mode-specific settings
 browse-url-epiphany-new-window-is-tab t
 browse-url-firefox-new-window-is-tab t
 browse-url-galeon-new-window-is-tab t
 browse-url-mozilla-new-window-is-tab t
 browse-url-new-window-flag t
 compilation-scroll-output t
 compilation-window-height 18
 completion-pcm-complete-word-inserts-delimiters t
 completion-styles '(partial-completion initials)
 comint-input-ignoredups t
 comint-scroll-show-maximum-output nil
 cperl-auto-newline t
 cperl-auto-newline-after-colon t
 cperl-autoindent-on-semi t
 cperl-electric-backspace-untabify t
 cperl-electric-parens-mark t
 custom-unlispify-tag-names nil
 message-insert-canlock nil            ; gnus, leave my custom-file alone!
 develock-auto-enable nil              ; http://bugs.debian.org/446149
 describe-char-unicodedata-file (car   ; Debian includes this in `perl-modules'.
                                 (file-expand-wildcards
                                  "/usr/share/perl/*/unicore/UnicodeData.txt"))
 delete-old-versions t
 diff-default-read-only nil
 diff-switches "-ud"
 directory-free-space-args "-Ph"
 dired-listing-switches "-Alh"
 dired-details-hidden-string ""
 dired-details-initially-hide nil
 ;; Suppress dired-x's stupid "command guessing".
 dired-guess-shell-alist-default nil
 ediff-grab-mouse nil
 ediff-split-window-function 'split-window-horizontally
 ediff-window-setup-function 'ediff-setup-windows-plain
 eldoc-idle-delay 0
 eshell-save-history-on-exit t
 find-ls-option                         ; http://emacsbugs.donarmstrong.com/4403
 (let ((help (shell-command-to-string (format "%s --help" find-program))))
   (if (string-match " -ls\\>" help)
       '("-ls" . "-lids")
     (if (string-match "{} \\+" help)
         '("-exec ls -ldh {} +" . "-ldh")
       '("-exec ls -ldh {} \\;" . "-ldh"))))

 gnus-inhibit-startup-message t
 gnus-agent-expire-all t                ; allow uncaching of unread articles
 gnus-agent-article-alist-save-format 2 ; compress cache
 haskell-program-name (cond ((executable-find "hugs")
                             "hugs -98")
                            ((executable-find "ghci")
                             "ghci -fglasgow-exts"))
 ibuffer-default-sorting-mode 'major-mode
 ido-default-buffer-method 'selected-window
 ido-default-file-method 'selected-window
 ido-enable-prefix t
 ido-enable-flex-matching t
 ido-save-directory-list-file "~/.emacs.d/ido.last"
 ido-use-filename-at-point 'guess
 ido-use-url-at-point t
 line-move-visual nil                   ; I am *not* a NOTEPAD.EXE refugee!
 recentf-save-file "~/.emacs.d/recentf.eld"
 rfcview-rfc-location-pattern "http://tools.ietf.org/rfc/rfc%s.txt" ; FIXME, still wrong...
 eshell-directory-name "~/.emacs.d/eshell/"
 save-place-file "~/.emacs.d/saved-places.eld"
 slime-display-compilation-output nil
 slime-complete-symbol-function 'slime-complete-symbol*
 slime-kill-without-query-p t
 slime-startup-animation nil
 sql-sqlite-program "sqlite3"
 vc-dired-listing-switches "-Alh"
 vc-follow-symlinks t
 write-region-inhibit-fsync t           ; don't fuck up my I/O so hard
 w3m-bookmark-file-coding-system 'utf-8
 w3m-coding-system 'utf-8
 w3m-default-coding-system 'utf-8
 w3m-default-save-directory "~/Desktop/"
 w3m-enable-google-feeling-lucky nil ; When I type "foo.org", I want "http://foo.org", not google.
 w3m-file-coding-system 'utf-8
 w3m-file-name-coding-system 'utf-8
 w3m-key-binding 'info
 w3m-pop-up-windows nil
 w3m-search-engine-alist
 '(("google" "http://encrypted.google.com/search?q=%s")
   ;; ("google" "http://google.com.au/search?q=%s")
   ("wikipedia" "https://en.wikipedia.org/wiki/Special:Search/%s")
   ;; ("wikipedia" "http://en.wikipedia.org/wiki/Special:Search/%s")
   ;; ("duckduckgo" "https://duckduckgo.com/lite" nil "q=%s")
   ("duckduckgo" "https://duckduckgo.com/lite?q=%s"))
 w3m-search-default-engine "wikipedia"
 w3m-show-decoded-url nil               ; http://bugs.debian.org/457909
 w3m-show-graphic-icons-in-header-line nil
 w3m-show-graphic-icons-in-mode-line nil
 w3m-terminal-coding-system 'utf-8
 w3m-toggle-inline-images-permanently nil
 w3m-track-mouse nil
 w3m-use-cookies t
 w3m-use-favicon nil
 w3m-use-header-line nil
 w3m-use-mule-ucs t
 w3m-use-symbol t       ; Always use Unicode (not ASCII) box drawing characters.
 w3m-use-tab-menubar nil
 w3m-use-toolbar nil

 ;; A more mutt-like threading look
 gnus-sum-thread-tree-false-root "─*> "
 gnus-sum-thread-tree-indent "  "
 gnus-sum-thread-tree-leaf-with-other "├─> "
 gnus-sum-thread-tree-root "> "
 gnus-sum-thread-tree-single-indent ""
 gnus-sum-thread-tree-single-leaf "└─> "
 gnus-sum-thread-tree-vertical "│ "
 gnus-user-date-format-alist '((t . "%b %e"))
 gnus-summary-line-format "%4N %U%R%z %&user-date; %-14,14n (%4L) %B%s\n")

(mapc (lambda (x)
        (put x 'disabled nil))
      '(downcase-region upcase-region scroll-left dired-find-alternate-file))

(mapc (lambda (x)
        (put x 'safe-local-variable 'identity)) ; this is a cop-out
      '(package Package PACKAGE         ; for pre-SLIME Lisp code
        scheme48-package sql-product conf-space-keywords))

(mapc (lambda (x)
        (put x 'lisp-indent-function 1))
      '(add-to-list font-lock-add-keywords global-set-key))

;; Make paredit "play nice" with delsel (delete selection) mode.
(put 'paredit-backward-delete 'delete-selection 'supersede)
(put 'when 'scheme-indent-function 1)
(put 'unless 'scheme-indent-function 1)

;;; minor mode activation
(require 'saveplace nil t)
(global-font-lock-mode +1)
(transient-mark-mode +1)
(delete-selection-mode +1)
(auto-compression-mode +1)
(show-paren-mode +1)
(when (fboundp 'partial-completion-mode)
  (partial-completion-mode +1))         ; obsolete in Emacs 24
(line-number-mode +1)
(column-number-mode +1)
(icomplete-mode +1)
(menu-bar-mode -1)
(when (featurep 'x)
  (tool-bar-mode -1)
  (scroll-bar-mode -1))
(savehist-mode +1)
(when (fboundp 'epa-mode)               ; new in CVS Feb 2008
  (epa-mode +1))
(ido-mode +1)
(ido-everywhere +1)
(mapc (lambda (x)
        (add-hook x 'turn-on-eldoc-mode))
      ;; A major mode supports eldoc iff it defines
      ;; `eldoc-documentation-function'.
      '(emacs-lisp-mode-hook ielm-mode-hook))
(when (fboundp 'enable-paredit-mode)
  (mapc (lambda (x)
          (add-hook x 'enable-paredit-mode))
        '(emacs-lisp-mode-hook ielm-mode-hook
          lisp-mode-hook inferior-lisp-mode-hook
          slime-repl-mode-hook
          scheme-mode-hook inferior-scheme-mode-hook
          haskell-mode-hook literate-haskell-mode-hook inferior-haskell-mode-hook
          python-mode-hook inferior-python-mode-hook)))
(when (fboundp 'slime-mode)
  (add-hook 'lisp-mode-hook 'slime-mode))
(when (and (fboundp 'xterm-mouse-mode)
           (tty-type)                   ; mtty version
           (featurep 'mouse))
  (xterm-mouse-mode +1)
  (when (fboundp 'mwheel-scroll)
    (global-set-key (kbd "<mouse-4>") 'mwheel-scroll)
    (global-set-key (kbd "<mouse-5>") 'mwheel-scroll)))

;;; face customization
(if (not (memq 'xft (frame-parameter nil 'font-backend)))
    (set-face-attribute 'default nil :family "Terminus")
  (set-face-attribute 'default nil :family "DejaVu Sans Mono")
  (set-face-attribute 'variable-pitch nil :family "DejaVu Sans"))
(set-face-attribute 'fixed-pitch nil :family (face-attribute 'default :family))
(custom-set-faces
 '(mode-line-inactive   ((t :inherit default)))
 '(mode-line            ((t :inherit mode-line-inactive :inverse-video t)))
 '(header-line          ((t :inherit mode-line-inactive)))
 '(mode-line-emphasis   ((t :inherit bold)))
 '(mode-line-highlight  ((t :inherit highlight)))
 '(highlight            ((t :inherit default :foreground "green")))
 '(rcirc-track-nick     ((t :inherit mode-line-highlight)))
 '(rcirc-track-keyword  ((t :inherit mode-line-emphasis)))
 '(rcirc-my-nick        ((t :inherit font-lock-function-name-face)))
 '(rcirc-other-nick     ((t :inherit shadow)))
 '(rcirc-bright-nick    ((t :inherit highlight)))
 '(mode-line-buffer-id  ((t :inherit bold)))
 '(show-paren-match     ((t :inherit lazy-highlight)))
 '(show-paren-mismatch  ((t :inherit isearch)))
 '(dired-marked         ((t :inherit dired-mark)))
 '(diff-changed         ((t :inherit default      :foreground "yellow")))
 '(diff-added           ((t :inherit diff-changed :foreground "green")))
 '(diff-removed         ((t :inherit diff-changed :foreground "red")))

 ;; The default "dim grey" background is unreadable yellow on three-bit tty.
 '(magit-item-highlight ((t :inherit bold)))

 ;; '(w3m-bold                   ((t :inherit bold)))
 ;; '(w3m-underline              ((t :inherit underline)))
 ;; '(w3m-italic                 ((t :inherit italic)))
 ;; '(w3m-current-anchor         ((t :inherit bold-italic)))
 '(w3m-tab-background            ((t :inherit header-line)))
 '(w3m-selected-tab-background   ((t :inherit header-line)))
 ;; '(w3m-anchor                 ((t :inherit link :underline nil)))
 '(w3m-arrived-anchor            ((t :inherit link-visited       :underline nil)))
 '(w3m-image-anchor              ((t :inherit w3m-anchor         :foreground "green")))
 '(w3m-tab-unselected            ((t :inherit w3m-tab-background)))
 '(w3m-tab-unselected-retrieving ((t :inherit w3m-tab-unselected :foreground "red")))
 '(w3m-tab-unselected-unseen     ((t :inherit w3m-tab-unselected :foreground "blue")))
 '(w3m-tab-selected              ((t :inherit w3m-tab-unselected :bold t)))
 '(w3m-tab-selected-retrieving   ((t :inherit w3m-tab-selected   :foreground "red")))
 ;; I'm not too keen on the remaining inheritances...
 ;; '(w3m-form-button            ((t :inherit widget-button)))
 ;; '(w3m-form-button-mouse      ((t :inherit widget-mouse-face)))
 ;; '(w3m-form-button-pressed    ((t :inherit widget-button-pressed)))
 ;; '(w3m-form-face              ((t :inherit widget-field)))
 )
;; Colour comment bodies in console mode.  I tried to get this changed upstream,
;; but RMS decreed that it was a feature as (apparently) red is difficult to
;; read on eight-colour terminals.  Hopefully a circular dependency is OK...
(eval-after-load "font-lock"
  '(if (< emacs-major-version 24)
       (put 'font-lock-comment-face 'face-alias 'font-lock-comment-delimiter-face)
     ;; UPDATE: it's not OK in Emacs 24.  For now, just assume an 8-color tty.
     (set-face-attribute 'font-lock-comment-face nil :foreground "red")))
(eval-after-load "dired"
  '(define-key dired-mode-map "r" 'wdired-change-to-wdired-mode))
(eval-after-load "ido"
  '(eval-after-load "dired"
     '(put 'ido-subdir 'face-alias 'dired-directory)))
(eval-after-load "eshell"
  '(eval-after-load "dired"
     '(progn
        (put 'eshell-ls-directory 'face-alias 'dired-directory)
        (put 'eshell-ls-symlink   'face-alias 'dired-symlink)
        (put 'eshell-ls-backup    'face-alias 'dired-ignored))))
(eval-after-load "rst"           ; these faces are unreadable on ttys by default
  '(when (require 'gnus-cite nil t)
     (put 'rst-level-1-face 'face-alias 'gnus-cite-1)
     (put 'rst-level-2-face 'face-alias 'gnus-cite-2)
     (put 'rst-level-3-face 'face-alias 'gnus-cite-3)
     (put 'rst-level-4-face 'face-alias 'gnus-cite-4)
     (put 'rst-level-5-face 'face-alias 'gnus-cite-5)
     (put 'rst-level-6-face 'face-alias 'gnus-cite-6)))
(mapc (lambda (major-mode) ; Similar to http://emacswiki.org/wiki/PrettyLambda
        (font-lock-add-keywords major-mode
          `(("(\\(lambda\\)\\>"
             (0 (prog1 ()
                  (compose-region (match-beginning 1)
                                  (match-end 1)
                                  ,(make-char 'greek-iso8859-7 107))))))))
      '(emacs-lisp-mode
        inferior-emacs-lisp-mode
        lisp-mode
        slime-repl-mode
        inferior-lisp-mode
        scheme-mode
        scheme48-mode
        inferior-scheme-mode))

;;; keybinding customization
(global-set-key (kbd "C-x C-k") 'kill-this-buffer)
(global-set-key (kbd "M-a") 'mode-line-other-buffer)      ; :other
(global-set-key (kbd "M-o") 'other-window)                ; :focus
(global-set-key (kbd "M-z") (cond ((fboundp 'next-buffer) ; :next
                                   'next-buffer)
                                  ((fboundp 'cyclebuffer-forward)
                                   'cyclebuffer-forward)))
(global-set-key [(control x) up] 'windmove-up)
(global-set-key [(control x) down] 'windmove-down)
(global-set-key [(control x) left] 'windmove-left)
(global-set-key [(control x) right] 'windmove-right)
(global-set-key (kbd "C--")
  (lambda ()
    (interactive)
    (set-face-attribute 'default nil :height 120)))
(global-set-key (kbd "C-0")
  (lambda ()
    (interactive)
    (set-face-attribute 'default nil :height 200)))
(global-set-key (kbd "C-=")
  (lambda ()
    (interactive)
    (set-face-attribute 'default nil :height 320)))
(when (fboundp 'ibuffer)
  (global-set-key (kbd "C-x C-b") 'ibuffer))
(eval-after-load "rcirc"                ; Don't steal my global M-o binding.
  '(define-key rcirc-mode-map (kbd "M-o") nil))
(eval-after-load "markdown-mode"        ; It's ^J, not ^M, you fuckwad!
  '(define-key markdown-mode-map (kbd "C-m") nil))
(eval-after-load "w3m"
  '(progn
     ;; Leave the modern C-l binding in place.
     (define-key w3m-mode-map (kbd "C-l") nil)
     ;; Stop w3m stealing my global M-a binding.
     (define-key w3m-mode-map (kbd "M-a") nil)
     ;; make B do same thing as in w3m.
     (define-key w3m-mode-map (kbd "B") 'w3m-view-previous-page)))
(eval-after-load "diff-mode"
  '(progn               ; don't steal M-q (fill-paragraph); I edit diff headers.
     (define-key diff-mode-map (kbd "M-q") nil)
     (define-key diff-minor-mode-map (kbd "M-q") nil)))
(if (or (< emacs-major-version 24)
        (and (= emacs-major-version 24)
             (< emacs-minor-version 3)))
    (eval-after-load "sh-script"
      '(define-key sh-mode-map (kbd "<") 'self-insert-command))
  (add-hook 'sh-mode-hook (lambda () (sh-electric-here-document-mode -1))))
(eval-after-load "emacs-lisp/lisp-mode"
  '(progn
     (define-key emacs-lisp-mode-map (kbd "C-c C-z") 'ielm)
     (define-key emacs-lisp-mode-map (kbd "C-c C-l") 'load-file)
     (define-key emacs-lisp-mode-map (kbd "C-c C-k") 'byte-compile-file)))
(eval-after-load "dired"
  '(define-key dired-mode-map (kbd "C-c C-z") 'shell))
(eval-after-load "make-mode"
  '(define-key makefile-mode-map (kbd "C-c C-z") 'shell))
(eval-after-load "scheme"               ; for C-c C-z
  '(require 'cmuscheme nil t))
(eval-after-load "sh-script"
  '(define-key sh-mode-map (kbd "C-c C-z") 'shell))
(eval-after-load "sql"
  '(define-key sql-mode-map (kbd "C-c C-z")
     (lambda ()
       (interactive)
       (let ((f (intern-soft (concat "sql-" (symbol-name sql-product)))))
         (if (and f (commandp f))
             (call-interactively f)
           (error (format "Can't connect to %s databases." sql-product)))))))
(eval-after-load "shell"
  '(define-key shell-mode-map (kbd "M-.")
     (lambda ()
       "Bash- or readline-like M-. binding."
       (interactive)
       (insert (car (last (split-string (ring-ref comint-input-ring 0))))))))
(eval-after-load "woman"
  '(progn
     (define-key woman-mode-map (kbd "l") 'WoMan-previous-manpage)
     (define-key woman-mode-map (kbd "/") 'isearch-forward-regexp)
     (define-key woman-mode-map (kbd "?") 'isearch-backward-regexp)))
(eval-after-load "view-mode"
  '(progn
     (define-key view-mode-map (kbd "/") 'isearch-forward-regexp)
     (define-key view-mode-map (kbd "?") 'isearch-backward-regexp)))
(eval-after-load "paredit"
  '(progn                               ; swap these back to how they used to be.
     (define-key paredit-mode-map (kbd ")") 'paredit-close-round-and-newline)
     (define-key paredit-mode-map (kbd "M-)") 'paredit-close-round)
     (define-key paredit-mode-map (kbd "}") 'paredit-close-curly-and-newline)
     (define-key paredit-mode-map (kbd "{") 'paredit-open-curly)))
(define-key key-translation-map (kbd "C-h") (kbd "DEL"))


;;; major mode voodoo
(mapc (lambda (x)
        ;; This is like aliasing perl-mode to cperl-mode, but still
        ;; allows me to do M-x perl-mode RET if I really want to.
        (when (eq 'perl-mode (cdr x))
          (setcdr x 'cperl-mode))
        (when (or (eq 'sgml-mode (cdr x))
                  (eq 'xml-mode (cdr x)))
          (setcdr x 'nxml-mode)))
      (append auto-mode-alist interpreter-mode-alist))
(defalias 'hoogle 'haskell-hoogle)
(add-to-list 'completion-ignored-extensions ".hi")
(add-to-list 'auto-mode-alist '("\\.json\\'" . python-mode))
(add-to-list 'auto-mode-alist '("\\.asd\\'" . lisp-mode))
(add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-mode))
(add-to-list 'auto-mode-alist '("\\.lhs\\'" . literate-haskell-mode))
(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode))
(add-to-list 'interpreter-mode-alist '("runhaskell" . haskell-mode))
(add-to-list 'interpreter-mode-alist '("runhugs" . haskell-mode))
(add-to-list 'interpreter-mode-alist '("runghc" . haskell-mode))
(add-to-list 'interpreter-mode-alist '("expect" . tcl-mode))
(add-to-list 'auto-mode-alist '("/quilt_header\\.......\\'" . conf-colon-mode)) ; DEP-3
(add-to-list 'auto-mode-alist '("/debian/\\([^/]+\\.\\)?\\(clean\\|dirs\\|docs\\|install\\|manpages\\|upstart\\)\\'" . conf-mode))
(add-to-list 'auto-mode-alist '("/debian/\\(watch\\)\\'" . conf-mode))
(add-to-list 'auto-mode-alist '("/debian/copyright\\'" . conf-colon-mode)) ; DEP-5
(add-to-list 'auto-mode-alist '("/debian/patches/[^/]+\\'" . diff-mode)) ; 3.0 (quilt).
(add-to-list 'auto-mode-alist '("\\.ldif\\'" . conf-mode))
(add-to-list 'auto-mode-alist
  '("\\`\\(/var\\)?/tmp/mutt-" . mail-mode))
(when (fboundp 'rst-mode)               ; filthy kludge for gitit
  '(add-to-list 'auto-mode-alist '("\\.page\\'" . rst-mode)))
(when (fboundp 'markdown-mode)
  (add-to-list 'auto-mode-alist '("\\.mdwn\\'" . markdown-mode)))
(when (fboundp 'scheme48-mode)
  (add-hook 'hack-local-variables-hook
            (lambda ()
              (when (and (boundp 'scheme48-package)
                         scheme48-package)
                (scheme48-mode)
                (hack-local-variables-prop-line)))))
(when (and (fboundp 'w3m-browse-url)
           (executable-find "w3m"))
  (setq browse-url-browser-function 'w3m-browse-url))

;;; Miscellaneous.
(add-hook 'find-file-hook
          (lambda () (when buffer-read-only (view-mode +1))))

;;; http://whome.phys.au.dk/~harder/dpans.html
;;; Use C-h S to lookup symbols in the spec.
(eval-after-load "info-look"
  '(info-lookup-add-help
    :mode 'lisp-mode
    :regexp "[^][()'\" \t\n]+"
    :ignore-case t
    :doc-spec '(("(ansicl)Symbol Index" nil nil nil))))

(eval-after-load "w3m"
  '(setcdr (assoc "application/pdf" w3m-content-type-alist)
           `("\\.pdf\\'" (,(or (executable-find "evince")
                               (executable-find "epdfview")
                               (executable-find "xpdf")) file) nil)))

(when (executable-find "twb-browser")
  (eval-after-load "browse-url"
    '(defun browse-url-default-browser (url &rest unused)
       (cond ((and window-system (getenv "DISPLAY"))
              (call-process "twb-browser" nil 0 nil url))
             ((getenv "STY")
              ;; This is BROKEN because Screen does test -t 0 before realizing
              ;; that it doesn't need a controlling tty to make a new window.
              ;(call-process "screen" nil 0 nil "twb-browser" url)
              (call-process "screen" nil 0 nil "-X" "screen" "env" "TERM=jfbterm" "twb-browser" url))
             (nil
              (error "cannot start fancy-pants browser"))))))

(progn                           ; Know about lzma and xz as well as gzip/bzip2.
  (add-to-list 'jka-compr-compression-info-list
    ["\\.lzma\\(~\\|\\.~[0-9]+~\\)?\\'" nil "lzma"  nil nil "unlzma" nil nil t ""])
  (add-to-list 'jka-compr-compression-info-list
    ["\\.xz\\(~\\|\\.~[0-9]+~\\)?\\'" nil "xz"  nil nil "unxz" nil nil t ""])
  (jka-compr-set 'jka-compr-compression-info-list jka-compr-compression-info-list)
  (eval-after-load "dired-aux"
    '(progn
       (add-to-list 'dired-compress-file-suffixes '("\\.lzma\\'" "" "unlzma"))
       (add-to-list 'dired-compress-file-suffixes '("\\.xz\\'" "" "unxz")))))

(unless (file-executable-p "/usr/sbin/sendmail")
  (setq message-send-mail-function 'smtpmail-send-it
        send-mail-function 'smtpmail-send-it))

;;; Don't turn Unicode characters into gibberish.
(eval-after-load "darcsum"
  '(add-to-list 'darcsum-output-environment "DARCS_DONT_ESCAPE_ANYTHING=1"))

;;; Quack is FUCKING UGLY; stop emacs-goodies-el from loading it.
(eval-after-load "emacs-goodies-el"
 '(progn
    (remove-hook 'scheme-mode-hook 'quack-scheme-mode-hookfunc)
    (remove-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)))

;; Apparently 80 columns is the standard for Debian control files.
(add-hook 'debian-control-mode-hook (lambda () (setq fill-column 80)))

(add-hook 'lisp-mode-hook
          (lambda ()
            (set (make-local-variable 'lisp-indent-function)
                 'common-lisp-indent-function)))

(eval-after-load "dired"
  '(when (require 'dired-details nil t)
     (dired-details-install)))

(eval-after-load "rst"
  '(add-hook 'rst-adjust-hook 'rst-toc-update))

(progn
  (setq slime-lisp-implementations nil)
  (mapc (lambda (x)
          (when (executable-find x)
            (add-to-list 'slime-lisp-implementations
              (list (intern x) (list x)))))
        ;; in order of least to most preferred:
        (if (string-match "darwin" system-configuration)
            '("ecl" "gclcvs" "clisp" "sbcl" "cmucl" "openmcl")
          '("ecl" "gclcvs" "clisp" "openmcl" "sbcl" "cmucl")))
  (setq slime-default-lisp (caar slime-lisp-implementations))
  (setq inferior-lisp-program (caar (cdar slime-lisp-implementations))))

(let ((xs '("scheme48" "csi" "gsi" "scheme" "bigloo" "mzscheme" "rs"
            "elk" "gosh" "guile-1.6" "guile1.4" "scsh" "scm"
            "sigscheme" "festival")))
  (setq scheme-program-name (if (featurep 'cl)
                                (find-if 'executable-find xs)
                              ;; longhand version
                              (catch 'found
                                (mapc (lambda (x)
                                        (when (executable-find x)
                                          (throw 'found x)))
                                      xs))))
  (mapc (lambda (x)
          (add-to-list 'interpreter-mode-alist (cons x 'scheme-mode)))
        xs))

;;; Treat | as an identifier char; necessary for pipes in scsh.
(eval-after-load "scheme"
  '(modify-syntax-entry ?\| "_ 23bn" scheme-mode-syntax-table))

(load "scheme-voodoo" t t) ; http://paste.lisp.org/display/18404/raw

;; Normally C-x C-c does the right thing, but if you are in M-x shell and use
;; emacsclient to pop up a new buffer without creating a new terminal, then C-x
;; C-c will close the frame instead of closing the buffer.
(eval-after-load "server"
  '(global-set-key (kbd "C-x C-c")
     (lambda ()
       (interactive)
       (call-interactively
        (if server-buffer-clients 'server-edit 'save-buffers-kill-terminal)))))

;;; Guerilla patch -- http://bugs.debian.org/674744
(eval-after-load "w3m-search"
  '(defun w3m-search-escape-query-string (str &optional coding)
     (mapconcat
      (lambda (s)
        (w3m-url-encode-string s (or coding w3m-default-coding-system)))
      (split-string str)
      "%20")))

(add-hook 'w3m-mode-hook
          (lambda ()
            (setq show-trailing-whitespace nil)))

(eval-after-load "tramp"
  '(progn
     (add-to-list 'tramp-methods
       (cons "sudoHs" (copy-tree (cdr (assoc "sudo" tramp-methods)))))
     (let ((x (cdr (cadr (assoc 'tramp-login-args (cdr (assoc "sudo" tramp-methods)))))))
       (setcar x (cons "-i" (delete "-H" (delete "-s" (car x))))))
     (let ((x (cdr (cadr (assoc 'tramp-login-args (cdr (assoc "sudoHs" tramp-methods)))))))
       (setcar x (cons "-H" (delete "-H" (car x)))))))

;; The tramp people think it's acceptable to write a SEPARATE workaround for
;; every app that checks if stdout is a tty, to prevent M-! hanging.  Sigh.
(eval-after-load (if (locate-library "tramp-sh") "tramp-sh" "tramp")
  '(setq tramp-remote-process-environment
         (nconc tramp-remote-process-environment
                '("GIT_PAGER=cat" "DARCS_PAGER=cat"
                  ;; My own wrappers work by testing for a tty, too!
                  "PAGER=cat" "EDITOR=ed" "VISUAL=ed" "BROWSER=w3m -dump"))))

(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
(add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)

;;; Attempt to avoid problem in sh/bash where you edit a script while it's
;;; running, and the interpreter gets confused because its offset into the file
;;; suddenly points to the wrong place.
(add-hook 'sh-mode-hook (lambda () (set (make-local-variable 'file-precious-flag) t)))

;;; git-mergetool knows how to invoke emerge, but I prefer ediff.  Rather than
;;; educate git-mergetool, just redefine the emerge interface to use ediff.
(eval-after-load "emerge"
  '(progn
     (defun emerge-files-command ()
       (let ((a   (nth 0 command-line-args-left))
             (b   (nth 1 command-line-args-left))
             (out (nth 2 command-line-args-left)))
         (setq command-line-args-left
               (nthcdr 3 command-line-args-left))
         (ediff-merge-files a b nil out)))
     (defun emerge-files-with-ancestor-command ()
       (let ((a   (nth 0 command-line-args-left))
             (b   (nth 1 command-line-args-left))
             (anc (nth 2 command-line-args-left))
             (out (nth 3 command-line-args-left)))
         (setq command-line-args-left
               (nthcdr 4 command-line-args-left))
         (ediff-merge-files-with-ancestor a b anc nil out)))))

;;; Guerilla patch -- Pass -layout not -raw (http://debbugs.gnu.org/8519).
(eval-after-load "doc-view"
  '(defun doc-view-pdf->txt (pdf txt callback)
     (or doc-view-pdftotext-program
         (error "You need the `pdftotext' program to convert a PDF to text"))
     (doc-view-start-process "pdf->txt" doc-view-pdftotext-program
                             (list "-layout" pdf txt)
                             callback)))

;;; Guerilla patch -- redefine FIND-DIRED to act less like RGREP and more like
;;; GREP.  That is, prompt for an arbitrary command instead of "helpfully"
;;; constructing a command from an inflexible series of prompts.  Defaults to
;;; "find -ls"; "find -exec ls {} +" is also possible to e.g. sort by file size.
(eval-after-load "dired"
  '(eval-after-load "find-dired"
     '(progn
        (defvar find-command/twb (concat find-program " " (car find-ls-option)))
        (defvar find-command-history/twb nil)
        (defun find-dired (command)
          "Like find-dired, but let me just WRITE the command instead of
trying to construct it for me.  Cf. `grep' vs. `rgrep'."
          (interactive (list (read-string "Run find: " find-command/twb '(find-command-history/twb . 1))))
          (let ((dired-buffers dired-buffers)
                (dir default-directory))
            (switch-to-buffer (get-buffer-create "*Find*"))
            (setq default-directory dir)

            ;; See if there's still a `find' running, and offer to kill
            ;; it first, if it is.
            (let ((find (get-buffer-process (current-buffer))))
              (when find
                (if (or (not (eq (process-status find) 'run))
                        (yes-or-no-p "A `find' process is running; kill it? "))
                    (condition-case nil
                        (progn
                          (interrupt-process find)
                          (sit-for 1)
                          (delete-process find))
                      (error nil))
                  (error "Cannot have two processes in `%s' at once" (buffer-name)))))

            (widen)
            (kill-all-local-variables)
            (setq buffer-read-only nil)
            (erase-buffer)
            (setq find-command command) ; save for next interactive call
            ;; Start the find process.
            (shell-command (concat command "&") (current-buffer))
            ;; The next statement will bomb in classic dired (no optional arg allowed)
            (dired-mode default-directory (cdr find-ls-option))
            (let ((map (make-sparse-keymap)))
              (set-keymap-parent map (current-local-map))
              (define-key map "\C-c\C-k" 'kill-find)
              (use-local-map map))
            (make-local-variable 'dired-sort-inhibit)
            (setq dired-sort-inhibit t)
            (set (make-local-variable 'revert-buffer-function)
                 `(lambda (ignore-auto noconfirm)
                    (find-dired ,find-command)))
            ;; Set subdir-alist so that Tree Dired will work:
            (if (fboundp 'dired-simple-subdir-alist)
                ;; will work even with nested dired format (dired-nstd.el,v 1.15
                ;; and later)
                (dired-simple-subdir-alist)
              ;; else we have an ancient tree dired (or classic dired, where
              ;; this does no harm)
              (set (make-local-variable 'dired-subdir-alist)
                   (list (cons default-directory (point-min-marker)))))
            (set (make-local-variable 'dired-subdir-switches) find-ls-subdir-switches)
            (setq buffer-read-only nil)
            ;; Subdir headlerline must come first because the first marker in
            ;; subdir-alist points there.
            (insert "  " default-directory ":\n")
            ;; Make second line a ``find'' line in analogy to the ``total'' or
            ;; ``wildcard'' line.
            (insert "  " command "\n")
            (setq buffer-read-only t)
            (let ((proc (get-buffer-process (current-buffer))))
              (set-process-filter proc (function find-dired-filter))
              (set-process-sentinel proc (function find-dired-sentinel))
              ;; Initialize the process marker; it is used by the filter.
              (move-marker (process-mark proc) 1 (current-buffer)))
            (setq mode-line-process '(":%s")))))))


;;; Load application code.
(load "~/.rcirc" t t)
(load "~/.screen" t t)