path: root/dotfiles/.emacs.d/init.el

;; Turn off mouse interface early in startup to avoid momentary display
(if (fboundp 'tool-bar-mode) (tool-bar-mode -1))
(if (fboundp 'menu-bar-mode) (menu-bar-mode -1))
(if (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))

;; No splash screen.
(setf inhibit-startup-message t)

;; Maximize frames
(add-to-list 'default-frame-alist '(fullscreen . maximized))

;; Stop customize from writing to my init file.  Who thought this was
;; a good idea?
(setf custom-file "~/.emacs.d/custom.el")

(defmacro when-require (package &rest body)
  "Evaluate BODY if and only if PACKAGE can be imported."
  (declare (indent 1))
  `(when (require ,package nil t) ,@body))

(defun home-file (file-name)
    "Prefix FILE-NAME with the current home directory."
    (concat (getenv "HOME") file-name))

;;;
;;; Packages
;;;

(add-to-list 'load-path
             (home-file "/.guix-profile/share/emacs/site-lisp"))
;; (add-to-list 'load-path
;;              (home-file "/.guix-profile/share/emacs/site-lisp/guix.d/typo-1.1"))
;; (add-to-list 'load-path (home-file "/Code/guix/emacs"))

(when-require 'guix-init
  (setf guix-dot-program (concat (getenv "HOME") "/.guix-profile/bin/dot")))

(require 'package)
(add-to-list 'package-archives
             '("melpa" . "http://melpa.milkbox.net/packages/") t)
(package-initialize)

;; Additional packages that I use.
(setf required-packages
      '(better-defaults
        elfeed
        emms
        ido-ubiquitous
        js2-mode
        notmuch-unread
        rainbow-delimiters
        smex
        web-mode
        projectile
        markdown-mode
        yaml-mode
        glsl-mode))

(defun install-missing-packages ()
  "Install all required packages that haven't been installed."
  (interactive)
  (package-refresh-contents)
  (mapc (lambda (package)
          (unless (package-installed-p package)
            (package-install package)))
        required-packages)
  (message "Installed all missing packages!"))

;;;
;;; Look and Feel
;;;

(defun font-exists-p (font)
  "Return 't' if FONT exists."
  (not (null (x-list-fonts font))))

(when (font-exists-p "Inconsolata")
  (set-frame-font "Inconsolata-12" nil t))

(load-theme 'wombat t)
(column-number-mode t)
(which-function-mode t)

(defun change-theme (theme)
  "Disable all active themes and load THEME."
  (interactive
   (lexical-let ((themes (mapcar 'symbol-name (custom-available-themes))))
     (list (intern (completing-read "Load custom theme: " themes)))))
  (mapc 'disable-theme custom-enabled-themes)
  (load-theme theme t))

;;;
;;; Dired
;;;

(require 'dired-x)

;;;
;;; TRAMP
;;;

(when-require 'tramp-sh
  ;; Include the current path for the system to TRAMP's remote path.
  ;; This is necessary for GuixSD, where the usual /usr/bin,
  ;; /usr/local/bin, etc. do not exist.
  (push 'tramp-own-remote-path tramp-remote-path))

;;;
;;; Battery
;;;

(require 'battery)

;; Display battery level in modeline only if a battery is present,
;; otherwise display-battery-mode will throw an error.
(when (and (boundp 'battery-status-function)
           (not (null battery-status-function))
           (not (string-match-p
                 "N/A"
                 (battery-format
                  "%B"
                  (funcall battery-status-function)))))
  (display-battery-mode t))

;;;
;;; Minibuffer
;;;

(setf ido-everywhere t
      ido-enable-flex-matching t)

(ido-mode t)

(when-require 'ido-ubiquitous
  (ido-ubiquitous-mode t))

;; Ignore compiled Guile files.  This has the side-effect of looking
;; like I hate GoLang.
(setf ido-ignore-files (cons "\\.go$" ido-ignore-files))

;; Much improved M-x prompt.
(when-require 'smex
  (global-set-key (kbd "M-x") 'smex))

;;;
;;; Buffers
;;;

;; Kill buffers that haven't been modified in awhile.
(require 'midnight)

;; Save point position between sessions
(require 'saveplace)
(setq-default save-place t)
(setq save-place-file (expand-file-name ".places" user-emacs-directory))

(defun cleanup-buffer-safe ()
  "Perform a bunch of safe operations on the whitespace content of a buffer.
Does not indent buffer, because it is used for a before-save-hook, and that
might be bad."
  (interactive)
  (delete-trailing-whitespace)
  (set-buffer-file-coding-system 'utf-8))

;; Various superfluous white-space. Just say no.
(add-hook 'before-save-hook 'cleanup-buffer-safe)

(setq ibuffer-saved-filter-groups
      '(("default"
         ("guile-2d" (filename . "Code/guile-2d/"))
         ("dired" (mode . dired-mode))
         ("org" (mode . org-mode))
         ("erc" (mode . erc-mode)))))

(add-hook 'ibuffer-mode-hook
          (lambda ()
            (ibuffer-switch-to-saved-filter-groups "default")))

;;;
;;; Tabs and Newlines
;;;

(setq-default indent-tabs-mode nil)
(setf indent-tabs-mode nil
      tab-width 2
      require-final-newline t)
(electric-indent-mode t)

;;;
;;; Version Control
;;;

(when-require 'magit
  (require 'magit-blame)

  ;; I don't like magit's default local tracking branch naming strategy.
  (setf magit-default-tracking-name-function
        'magit-default-tracking-name-branch-only)
  (setf magit-last-seen-setup-instructions "1.4.0")
  (setf magit-completing-read-function #'magit-ido-completing-read)

  (global-set-key (kbd "C-c g") 'magit-status))

;; Follow symlinks automatically instead of asking each time.
(setf vc-follow-symlinks t)

(when-require 'projectile (projectile-global-mode))

;;;
;;; Ediff
;;;

;; Don't break out a separate frame for ediff.
(setf ediff-window-setup-function 'ediff-setup-windows-plain
      ediff-split-window-function 'split-window-horizontally)

;;;
;;; C
;;;

(setq c-default-style "k&r")
(setq-default c-basic-offset 2)
(setq-default c-basic-indent 2)

;;;
;;; Javascript
;;;

(setf js-indent-level 2
      js2-basic-offset 2)
(when-require 'js2-mode
  (add-to-list 'auto-mode-alist '("\\.js$" . js2-mode)))

;;;
;;; Web
;;;

(when-require 'web-mode
  (add-hook 'web-mode-hook (lambda () (setq web-mode-markup-indent-offset 2)))
  (add-to-list 'auto-mode-alist '("\\.html$" . web-mode))
  (add-to-list 'auto-mode-alist '("\\.tpl$" . web-mode))
  (add-to-list 'auto-mode-alist '("\\.erb$" . web-mode)))

;;;
;;; PHP
;;;

(when-require 'php-mode
  (add-hook 'php-mode-hook (lambda () (setf c-basic-offset 2))))

;;;
;;; Lisp
;;;

(show-paren-mode t)

(defmacro use-mode-for-lisp (mode)
  `(progn
     (add-hook 'emacs-lisp-mode-hook       (lambda () (,mode t)))
     (add-hook 'lisp-mode-hook             (lambda () (,mode t)))
     (add-hook 'lisp-interaction-mode-hook (lambda () (,mode t)))
     (add-hook 'scheme-mode-hook           (lambda () (,mode t)))))

(when-require 'rainbow-delimiters
  (use-mode-for-lisp rainbow-delimiters-mode))

(when-require 'paredit
  (use-mode-for-lisp paredit-mode))

(when-require 'geiser-install
  (setf geiser-active-implementations '(guile))

  (global-set-key (kbd "C-c s") 'connect-to-guile))

;; Use scheme-mode for Skribe documents.
(add-to-list 'auto-mode-alist '("\\.skr$" . scheme-mode))

(when-require 'skribe
  ;; Activate Skribe minor mode on .skr files.
  (add-hook 'scheme-mode-hook
            (lambda ()
              (when (string-match "\\.skr$" (buffer-file-name))
                (skribe-mode t)
                (when-require 'typo
                  (typo-mode t))))))

(require 'scheme)

;; Hacked to properly indent keywords.  Thanks to mark_weaver.
(defun scheme-indent-function (indent-point state)
  "Scheme mode function for the value of the variable `lisp-indent-function'.
This behaves like the function `lisp-indent-function', except that:

i) it checks for a non-nil value of the property `scheme-indent-function'
\(or the deprecated `scheme-indent-hook'), rather than `lisp-indent-function'.

ii) if that property specifies a function, it is called with three
arguments (not two), the third argument being the default (i.e., current)
indentation."
  (let ((normal-indent (current-column)))
    (goto-char (1+ (elt state 1)))
    (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
    (if (and (elt state 2)
             (not (looking-at "\\sw\\|\\s_")))
        ;; car of form doesn't seem to be a symbol
        (progn
          (if (not (> (save-excursion (forward-line 1) (point))
                      calculate-lisp-indent-last-sexp))
              (progn (goto-char calculate-lisp-indent-last-sexp)
                     (beginning-of-line)
                     (parse-partial-sexp (point)
					 calculate-lisp-indent-last-sexp 0 t)))
          ;; Indent under the list or under the first sexp on the same
          ;; line as calculate-lisp-indent-last-sexp.  Note that first
          ;; thing on that line has to be complete sexp since we are
          ;; inside the innermost containing sexp.
          (backward-prefix-chars)
          (current-column))
      (let ((function (buffer-substring (point)
					(progn (forward-sexp 1) (point))))
	    method)
	(setq method (or (get (intern-soft function) 'scheme-indent-function)
			 (get (intern-soft function) 'scheme-indent-hook)))
	(cond ((or (eq method 'defun)
		   (and (null method)
			(> (length function) 3)
			(string-match "\\`def" function)))
	       (lisp-indent-defform state indent-point))
              ;; This next cond clause is the only change -mhw
	      ((and (null method)
                    (> (length function) 1)
                    ; The '#' in '#:' seems to get lost, not sure why
                    (string-match "\\`:" function))
               (let ((lisp-body-indent 1))
                 (lisp-indent-defform state indent-point)))
	      ((integerp method)
	       (lisp-indent-specform method state
				     indent-point normal-indent))
	      (method
               (funcall method state indent-point normal-indent)))))))

(defun connect-to-guile-wm ()
  "Connect to guile-wm's REPL server."
  (interactive)
  (geiser-connect 'guile "localhost" "37147"))

(defun connect-to-dmd ()
  "Connect to dmd's REPL server."
  (interactive)
  (geiser-connect 'guile "localhost" "37148"))

(put 'and-let* 'scheme-indent-function 1)
(put 'syntax-parameterize 'scheme-indent-function 1)
(put 'with-mutex 'scheme-indent-function 1)
(put 'test-group 'scheme-indent-function 1)
(put 'mock 'scheme-indent-function 1)
(put 'sxml-match 'scheme-indent-function 1)

;; TODO: Move to relevant project's .dir-locals.el
(put 'colambda 'scheme-indent-function 1)
(put 'codefine 'scheme-indent-function 1)
(put 'with-agenda 'scheme-indent-function 1)
(put 'with-mesh 'scheme-indent-function 1)
(put 'with-texture 'scheme-indent-function 1)
(put 'with-shader-program 'scheme-indent-function 1)
(put 'with-window 'scheme-indent-function 1)
(put 'bind-key-commands 'scheme-indent-function 2)
(put 'signal-let 'scheme-indent-function 1)
(put 'signal-let* 'scheme-indent-function 1)
(put 'with-framebuffer 'scheme-indent-function 1)
(put 'with-render-context 'scheme-indent-function 1)
(put 'with-push-context 'scheme-indent-function 1)
(put 'with-temp-transform 'scheme-indent-function 2)
(put 'chain 'scheme-indent-function 1)
(put 'call-with-input-bytevector 'scheme-indent-function 1)

;;;
;;; Ruby
;;;

;; Rake files are ruby, too, as are gemspecs, rackup files, etc.
(add-to-list 'auto-mode-alist '("\\.rake$" . ruby-mode))
(add-to-list 'auto-mode-alist '("\\.gemspec$" . ruby-mode))
(add-to-list 'auto-mode-alist '("\\.ru$" . ruby-mode))
(add-to-list 'auto-mode-alist '("Rakefile$" . ruby-mode))
(add-to-list 'auto-mode-alist '("Gemfile$" . ruby-mode))

;; Use ruby-test-mode
(when-require 'ruby-test-mode
  (add-hook 'ruby-mode-hook 'ruby-test-mode))

;;;
;;; SQL
;;;

;; Don't wrap lines so that table listings with a lot of columns
;; remain readable.
(add-hook 'sql-interactive-mode-hook
          (lambda () (setq truncate-lines t)))

;;;
;;; Org
;;;

(require 'ox-beamer)

(defun org-sort-by-priority-and-todo ()
  "Sort org entries first by priority, and then by TODO status."
  (interactive)
  (org-sort-entries nil ?p)
  (org-sort-entries nil ?o))

(add-hook 'org-mode-hook
          (lambda ()
            (local-set-key (kbd "C-c o") 'org-sort-by-priority-and-todo)))

;;;
;;; RSS
;;;

(when-require 'elfeed
  (setf elfeed-feeds
        '("http://planet.gnu.org/rss20.xml"
          "http://cs.worcester.edu/blog/feed/"
          "https://hacks.mozilla.org/feed/"
          "http://ebb.org/bkuhn/blog/rss.xml"))

  (global-set-key (kbd "C-c f") 'elfeed))

;;;
;;; Mail
;;;

(when-require 'notmuch
  ;; (when-require 'notmuch-unread
  ;;   (notmuch-unread-mode 1))

  (setf notmuch-crypto-process-mime t)

  (global-set-key (kbd "C-c m") 'notmuch)

  (setf notmuch-fcc-dirs
        '(("dthompson2@worcester.edu" . "WSU/Sent")
          ("davet@fsf.org" . "FSF/INBOX.Sent")
          ("davet@gnu.org" . "FSF/INBOX.Sent")
          ("dthompson@vistahigherlearning.com" . "VHL/Sent Items")
          (".*" . "sent")))

  (defun recent-mail-by-tag (tag)
    `(:name ,tag
      :query ,(concat "tag:" tag " AND date:today..today")
      :sort-order newest-first))

  (defun unread-mail-by-tag (tag)
    `(:name ,tag
      :query ,(concat "tag:" tag " AND tag:unread")
      :sort-order newest-first))

  (defun unarchived-mail-by-tag (tag)
    `(:name ,tag
      :query ,(concat "tag:" tag " AND NOT tag:archive")
      :sort-order newest-first))

  (setf notmuch-saved-searches
        `((:name "inbox"
           :query "tag:inbox"
           :sort-order newest-first)
          ,(unarchived-mail-by-tag "guix")
          ,(unarchived-mail-by-tag "guile")
          ,@(mapcar 'recent-mail-by-tag
                    '("nagios" "semaphore" "airbrake" "newrelic"
                      "rackspace" "vividcortex" "aws" "papertrail"
                      "codeclimate" "basecamp"))))

  (define-key notmuch-search-mode-map "u"
    (lambda ()
      "Remove 'unread' tag from message."
      (interactive)
      (notmuch-search-tag '("-unread"))
      (notmuch-search-next-thread)))

  (define-key notmuch-search-mode-map "a"
    (lambda ()
      "Remove 'unread' and 'inbox' tags from message and add
'archive' tag."
      (interactive)
      (notmuch-search-tag '("-unread" "-inbox" "+archive"))
      (notmuch-search-next-thread)))

  (define-key notmuch-search-mode-map "d"
    (lambda ()
      "Add 'deleted' tag to message."
      (interactive)
      (notmuch-search-tag '("+deleted"))
      (notmuch-search-next-thread)))

  (define-key notmuch-search-mode-map "i"
    (lambda ()
      "Remove 'unread' and 'archive' tags from message, and add
the 'inbox' tag."
      (interactive)
      (notmuch-search-tag '("-unread" "-archive" "+inbox"))
      (notmuch-search-next-thread)))

  (define-key notmuch-search-mode-map "s"
    (lambda ()
      "Remove 'unread' and 'inbox' tags from message, and add the
'spam' tag."
      (interactive)
      (notmuch-search-tag '("-unread" "-inbox" "+spam"))
      (notmuch-search-next-thread))))

(setf send-mail-function 'smtpmail-send-it
      smtpmail-smtp-server "smtp.gmail.com"
      smtpmail-smtp-service 587
      smtpmail-stream-type 'starttls)

;; Work email
(when (equalp system-name "7VWJD42")
  (setf send-mail-function 'smtpmail-send-it
        smtpmail-smtp-server "EXCHANGE02.vhl.dom"
        smtpmail-smtp-service 587
        smtpmail-stream-type 'starttls))

;;;
;;; Calendar
;;;

(when-require 'org-caldav
  (setf org-caldav-url
        "https://my.owndrive.com/remote.php/caldav/calendars/davexunit"
        org-caldav-calendar-id "defaultcalendar"
        org-caldav-inbox "~/Documents/calendar.org"
        org-caldav-files '()
        org-icalendar-timezone "America/New_York"))

;;;
;;; Music
;;;

(when-require 'emms
  (require 'emms-player-mpd)
  (require 'emms-mode-line)
  (require 'emms-browser)

  (emms-standard)
  (emms-mode-line 1)
  (setf emms-player-mpd-server-name "localhost"
        emms-player-mpd-server-port "6600"
        emms-volume-change-function 'emms-volume-mpd-change)
  (add-to-list 'emms-info-functions 'emms-info-mpd)
  (add-to-list 'emms-player-list 'emms-player-mpd)

  (global-set-key (kbd "C-c e e") 'emms)
  (global-set-key (kbd "C-c e b") 'emms-browser))

;;;
;;; Other
;;;

;; Load machine specific emacs configuration
(defvar local-config-filename "~/.emacs.d/local.el")
(if (file-exists-p local-config-filename)
    (load local-config-filename))

;; IRC configuration
(load "~/.emacs.d/erc.el")

;;;
;;; Keybindings
;;;

;; Handy functions courtesy of whattheemacs.d
(defun open-line-below ()
  (interactive)
  (if (eolp)
      (newline)
    (end-of-line)
    (newline))
  (indent-for-tab-command))

(defun open-line-above ()
  (interactive)
  (beginning-of-line)
  (newline)
  (forward-line -1)
  (indent-for-tab-command))

(global-set-key (kbd "RET") 'newline-and-indent)
(global-set-key (kbd "<C-return>") 'open-line-below)
(global-set-key (kbd "<C-M-return>") 'open-line-above)
(global-set-key (kbd "C-c i") 'start-irc)
(global-set-key (kbd "C-c p") 'package-list-packages)
(global-set-key (kbd "C-c C-f") 'ff-find-other-file)
(global-set-key (kbd "M-%") 'query-replace-regexp)
;; No more minimizing Emacs by accident.
(global-unset-key (kbd "C-z"))

;; Enable some disabled-by-default functions
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)