My Emacs configuration

.emacs

;; -*- mode: Emacs-Lisp; lexical-binding: t; -*-
;; Samuel Laurén 💗 2014-2015

;; # TODO
;; - Support tags

(setq gc-cons-threshold 50000000)

(require 'cl-lib)

(defvar package-archives '(("melpa" . "http://melpa.milkbox.net/packages/")
                           ("marmalade" . "http://marmalade-repo.org/packages/")
                           ("gnu" . "http://elpa.gnu.org/packages/")
                           ("org" . "http://orgmode.org/elpa/")))

(require 'package)
(package-initialize)

(unless package-archive-contents
  (package-refresh-contents))

;; Required modules

(defvar required-packages
  '(aggressive-indent
    auctex
    auto-complete
    color-theme-sanityinc-tomorrow
    diminish
    dpaste
    evil
    evil-numbers
    expand-region
    fic-mode
    flycheck
    flycheck-haskell
    multi-term
    gotham-theme
    google-translate
    haskell-mode
    helm
    helm-bibtex
    helm-projectile
    helm-descbinds
    markdown-mode
    nyan-mode
    hl-sexp
    paredit
    projectile
    rainbow-delimiters
    rainbow-mode
    transpose-frame
    twilight-bright-theme
    hemisu-theme
    twilight-anti-bright-theme
    espresso-theme
    django-theme
    wc-mode
    wcheck-mode
    weechat
    writegood-mode
    zoom-window))

(defun deps (&rest xs)
  (cl-some 'executable-find xs))

(defvar conditional-packages
  `((ag . ,(deps "ag"))
    (helm-ag . ,(deps "ag"))
    (geiser . ,(deps "guile" "racket"))
    (slime . ,(deps "sbcl"))
    (notmuch . ,(deps "notmuch"))
    (color-theme-approximate . ,(eq system-type 'gnu/linux))))

(dolist (package conditional-packages)
  (when (cdr package)
    (add-to-list 'required-packages (car package))))

(cl-loop for package in required-packages
         unless (package-installed-p package)
         do (package-install package))

(defun package-upgrade-all ()
  "Upgrade all installed packages"
  (interactive)
  (save-window-excursion
    (list-packages)
    (package-menu-mark-upgrades)
    (package-menu-execute)))


;; Prelude

(defun compose (fn &rest others)
  "Compose a set of functions"
  (let ((fns (cons fn others)))
    (lambda (&rest args)
      (cl-reduce (lambda (a b)
                   (funcall a b))
                 (butlast fns)
                 :from-end t
                 :initial-value (apply (car (last fns)) args)))))

(defun filter (fn xs)
  (cl-loop for x in xs
           when (funcall fn x)
           collect x))

(defmacro partial (fn &rest template)
  "Partially apply function using a template"
  `(lambda (&rest args)
     (let ((merged-args (cl-loop for arg in (quote ,template)
                                 if (eq arg '_) collect (pop args)
                                 else collect (eval arg))))
       (apply (quote ,fn) merged-args))))

(defmacro dlet* (varlist &rest body)
  "Destructuring let*"
  (declare (debug let)
           (indent 1))
  (cl-reduce (lambda (a b)
               `(cl-destructuring-bind ,(car a) ,(cadr a) ,b))
             varlist
             :from-end t
             :initial-value `(progn ,@body)))

(defun active (fn)
  "Make function interactive"
  (lambda (&rest args)
    (interactive)
    (apply fn args)))

;;; FIXME: b might be nil
(defun sliding-pairs (xs)
  (cl-loop for (a b) on xs by #'cdr when b collect (cons a b)))

(defun pairs (xs)
  (cl-loop for (a b) on xs by #'cddr collect (cons a b)))

(defmacro if-supported (fn &rest args)
  `(when (fboundp (quote ,fn)) (apply (quote ,fn) ,args)))

(defun bind-keys (&rest bindings)
  "Helper for binding multiple keys at once"
  (pcase bindings
    (`(:map ,m . ,b) (bind-keys-from-pairs m (pairs b)))
    (b (bind-keys-from-pairs (current-global-map) (pairs b)))))

(defun bind-keys-from-pairs (map bindings)
  (cl-loop for (binding . fn) in bindings
           do (define-key map (kbd binding) fn)))

(defun add-hooks (&rest hooks)
  "Helper for adding hooks"
  (cl-loop for (hook . fn) in (pairs hooks)
           do (add-hook hook fn)))

(defun other-windows? ()
  "Are there more than one window"
  (> (length (window-list)) 1))

(defmacro extend-list (sym to-be-added)
  "Add items from list to another"
  `(mapc (partial add-to-list (quote ,sym) _) ,to-be-added))

(defun uncurry (fn)
  (lambda (pair)
    (funcall fn (car pair) (cdr pair))))

(defun switch-theme (theme)
  "Unload existing theme and change to a new one."
  (interactive
   (list (intern
          (completing-read "Switch to theme: "
                           (mapcar #'symbol-name (custom-available-themes))
                           nil t))))
  (disable-theme (car custom-enabled-themes))
  (load-theme theme t))

(defmacro numeric-argument-switch (form &rest others)
  "Makes a function that executes a form based on a numeric argument."
  (let* ((forms (cons form others))
         (conds (cl-loop for f in forms
                         for i from 1 to (length forms)
                         collect `((= d ,i) ,f))))
    `(lambda (d)
       (interactive "p")
       (cond ,@conds
             (t (error "No action bound to %d" d))))))

(defun repeating (key fn &rest args)
  "Makes a function that can be repeated with additional key presses"
  (let ((map (make-sparse-keymap)))
    (cl-labels ((action ()
                        (interactive)
                        (apply fn args)
                        (set-transient-map map)))
      (define-key map (kbd key) #'action)
      #'action)))

(defun switch-to-buffer-dwim (buffer)
  "Display buffer in the selected window or, if the buffer is already visible in some window, switch focus to the window containing it."
  (let ((window (get-buffer-window buffer)))
    (if window
        (select-window window)
      (switch-to-buffer buffer))))

;; UTF-8 Everyday, everywhere

(prefer-coding-system 'utf-8)
(set-language-environment 'utf-8)
(set-default-coding-systems 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-selection-coding-system 'utf-8)

;; Quiet startup

(setq inhibit-splash-screen t
      inhibit-startup-message t
      initial-scratch-message (concat
                               (replace-regexp-in-string "^" ";; " (emacs-version))
                               "\n\n"))

;; schedule-events-mode for performing actions based on time of day

(defun current-time-of-day ()
  "Current time of day as a list of form (HOURS MINUTES SECONDS)."
  (dlet* ((time-string (format-time-string "%H %M %S"))
          ((h m s) (split-string time-string " ")))
    (list (string-to-number h 10)
          (string-to-number m 10)
          (string-to-number s 10))))

(defun time-of-day-before (a b)
  (dlet* (((h1 m1 s1) a)
          ((h2 m2 s2) b))
    (cond ((< h1 h2) t)
          ((= h1 h2)
           (cond ((< m1 m2) t)
                 ((= m1 m2)
                  (cond ((< s1 s2) t)
                        (t nil)))
                 (t nil)))
          (t nil))))

(defun time-of-day-< (a b &rest others)
  (let ((all (cons a (cons b others))))
    (cl-every #'identity
              (mapcar (uncurry #'time-of-day-before)
                      (sliding-pairs all)))))

(defvar schedule-events-schedule '()
  "List of form (((HOURS MINUTES SECONDS) . FUNCTION)).
Defines when to perform actions.")

(defvar schedule-events-last nil)

(defvar schedule-events-timer nil)

(defun schedule-events-applicable (time schedule)
  (let* ((last-action (cdar (last schedule)))
         (with-pseudo-events
          (cl-concatenate 'list
                          `(((0 0 0) . ,last-action)) schedule '(((23 59 60) . #'ignore))))
         (definition (cl-find-if (lambda (pair)
                                   (dlet* ((((time1 . a) . (time2 . b)) pair))
                                     (time-of-day-< time1 time time2)))
                                 (sliding-pairs with-pseudo-events))))
    (when definition
      (cdar definition))))

(define-minor-mode schedule-events-mode
  "Perform actions based on time of day"
  :lighter " schedule"
  :global t
  (if schedule-events-mode
      (progn
        (funcall (schedule-events-applicable (current-time-of-day) schedule-events-schedule))
        (setq schedule-events-timer
              (run-at-time 60 60 (lambda ()
                                   (let ((fn
                                          (schedule-events-applicable (current-time-of-day) schedule-events-schedule)))
                                     (unless (eq fn schedule-events-last)
                                       (setq schedule-events-last fn)
                                       (funcall fn)))))))
    (cancel-timer schedule-events-timer)))

;; General interface settings

(tool-bar-mode -1)

(scroll-bar-mode -1)

(blink-cursor-mode -1)

(menu-bar-mode -1)

(bind-keys "C-x t" 'toggle-menu-bar-mode-from-frame
           "C-w" 'backward-kill-word
           "<escape>" 'keyboard-quit
           "<f4>" (active (partial find-file user-init-file)))

(tooltip-mode -1)

(setq use-dialog-box nil)

(if-supported color-theme-approximate-on)

(setq schedule-events-schedule
      `(((7 0 0) . ,(partial switch-theme 'espresso))
        ((19 0 0) . ,(partial switch-theme 'twilight-anti-bright))))

;; Hopefully fixes a weird bug relating to ansi-term faces
(advice-add #'switch-theme :after
            (lambda (&rest _)
              (setq ansi-term-color-vector
                    [term term-color-black term-color-red term-color-green term-color-yellow 
                          term-color-blue term-color-magenta term-color-cyan term-color-white])))

(schedule-events-mode)

(setq-default fill-column 80)

(setq echo-keystrokes 0.1)

(show-paren-mode)

(global-prettify-symbols-mode)

(setq-default sentence-end-double-space nil)

(setq xterm-mouse-mode 1)

(fset 'yes-or-no-p 'y-or-n-p)

(setq confirm-nonexistent-file-or-buffer nil)

(setq vc-follow-symlinks t)

(column-number-mode)

(setq x-select-enable-clipboard t
      x-select-enable-primary t)

(setq ring-bell-function 'ignore)

(setq-default compilation-scroll-output t
              grep-scroll-output t)

(setq scroll-margin 3
      scroll-preserve-screen-position t)

(global-subword-mode)
(global-superword-mode)

;;; Stefan Monnier <foo at acm.org>. It is the opposite of fill-paragraph    
(defun unfill-paragraph (&optional region)
  "Takes a multi-line paragraph and makes it into a single line of text."
  (interactive (progn (barf-if-buffer-read-only) '(t)))
  (let ((fill-column (point-max)))
    (fill-paragraph nil region)))

(bind-keys "M-Q" 'unfill-paragraph)

(require 'multi-term)

(when (deps "bash")
  (setq shell-file-name "bash"
        multi-term-program "bash"))

(setq frame-title-format '((:eval (concat
                                   (if (buffer-file-name)
                                       (abbreviate-file-name (buffer-file-name))
                                     "%b")
                                   " - emacs"))))

(fringe-mode '(4 . 0))

(require 'uniquify)

(setq uniquify-buffer-name-style 'forward)

(require 'compile)

(setq compilation-read-command nil)

(delq 'process-kill-buffer-query-function kill-buffer-query-functions) ; This might be a bad idea

(bind-keys "C-c C-l" 'linum-mode
           "C-c C-w" 'whitespace-mode
           "C-c m" 'compile
           "C-c C-t" 'toggle-truncate-lines
           "C-c b" 'browse-url-at-point)

(global-unset-key (kbd "C-x f"))
(global-unset-key (kbd "C-x <escape> <escape>"))

;; Switch to or open a terminal

(defun switch-or-call (buffer-fn fn &rest args)
  (let ((buffer (funcall buffer-fn)))
    (if buffer
        (switch-to-buffer-other-window buffer)
      (apply fn args))))

(defun buffers-with-major-mode (mode)
  (filter
   (lambda (buffer) (with-current-buffer buffer (eq mode major-mode)))
   (buffer-list)))

(defun get-multi-term ()
  (interactive)
  (switch-or-call
   (compose 'car (partial buffers-with-major-mode 'term-mode))
   'multi-term))

(bind-keys "C-c <return>" 'get-multi-term
           "C-c <C-return>" 'multi-term)

;; Font

(defvar font-family
  '("Source Code Pro"
    "Fira Mono"
    "Droid Sans Mono"
    "Dejavu Sans Mono"
    "Source Code Pro")) ; Ugly hack to get around font loading problems

(defvar font-size
  (if (or (>= (display-pixel-width) 1680) (daemonp)) 9 8))

(defun first-available-font (&rest fonts)
  (or
   (car (filter (compose 'find-font (partial font-spec :name _)) (butlast fonts)))
   (car (last fonts))))

(add-to-list 'default-frame-alist
             `(font . ,(format "%s-%d" (apply 'first-available-font font-family) font-size))) 

;; Fix missing glyphs

(set-fontset-font "fontset-default" nil
                  (font-spec :size font-size :name "Symbola"))

;; 🌈 Use Nyan Mode only if we have just one window

;; (add-hook 'window-configuration-change-hook
;;           (lambda () (nyan-mode (if (other-windows?) -1 1))))

;; Remember state

;; (unless (daemonp)
;;   (desktop-save-mode))

(savehist-mode)

(require 'recentf)

(setq recentf-max-saved-items 1000)
(recentf-mode)

;; Helm

(require 'helm-config)
(require 'helm)

(helm-mode)

(setq helm-buffers-fuzzy-matching t
      helm-recentf-fuzzy-match t
      helm-M-x-fuzzy-match t
      helm-quick-update t)

(bind-keys "C-x C-f" 'helm-find-files
           "C-x b" 'helm-mini
           "C-x C-b" 'helm-buffers-list
           "C-x f" 'helm-projectile-find-file
           "C-x /" 'helm-occur
           "C-h b" 'helm-descbinds
           "C-c SPC" 'helm-imenu
           "M-x" 'helm-M-x
           "C-h a" 'helm-apropos
           "C-x g" 'helm-projectile-ag
           "C-h i" 'helm-info-emacs)

(bind-keys :map helm-map
           "<escape>" 'helm-keyboard-quit)

;; Default indentation

(setq-default indent-tabs-mode t
              tab-width 4)

;; Auto complete

(require 'auto-complete-config)
(add-to-list 'ac-dictionary-directories "~/.emacs.d/ac-dict")
(ac-config-default)

;; Project Management

(projectile-global-mode)
(helm-projectile-on)

(defun projectile-define-root ()
  "Create .projectile file to current buffer's directory"
  (interactive)
  (let ((file (buffer-file-name (current-buffer))))
    (when file
      (write-region "" nil (concat (file-name-directory file) ".projectile")))))

(setq projectile-mode-line
      '(:eval (if (projectile-project-p)
                  (format " <%s>" (projectile-project-name))
                "")))

(defun cd-here ()
  (interactive)
  (cd (file-name-directory buffer-file-name)))

(bind-keys "C-c p C" 'projectile-define-root
           "C-c p h" 'cd-here)

;; Backup files & Auto save

(setq backup-by-copying t
      backup-directory-alist '(("." . "~/.emacs.d/backups"))
      auto-save-file-name-transforms '((".*" "~/.emacs.d/saves" t))
      delete-old-versions t
      version-control t
      vc-make-backup-files t)

;; guess-language-mode for calling functions based on buffer's language

(defvar guess-language-common-words
  '((en . ("and" "or" "if" "the" "an" "it" "by" "can" "could" "this"))
    (fi . ("ja" "tai" "kun" "mutta" "ei" "tämä" "niin" "olla" "oli"))
    (sv . ("för" "kan" "är" "om" "ett" "inte" "jag" "det" "var")))
  "Defines a set of common words for each supported language")

(defun hash-table-apply (key fn table &optional default)
  (puthash key (funcall fn (gethash key table default)) table))

(defun guess-language-get-scores (str)
  (let ((scores (make-hash-table)))
    (cl-loop for word in (split-string str)
             do (cl-loop for (lang . common) in guess-language-common-words
                         when (member word common)
                         do (hash-table-apply lang '1+ scores 0)))
    scores))

(defun guess-language-sort-choices (scores)
  (cl-sort (cl-loop for lang being the hash-key in scores
                    using (hash-value score)
                    collect (cons lang score))
           '> :key 'cdr))

(defun guess-language-buffer ()
  (letrec ((scores (guess-language-get-scores (buffer-string)))
           (fit (guess-language-sort-choices scores)))
    (when fit
      (caar fit))))

(defvar guess-language-identified-alist '()
  "Association list connecting languages to functions")

(defvar-local buffer-language nil
  "Buffer's language")

(defvar-local guess-language-timer nil)

(defun guess-language-call-handler ()
  (let ((action (assq buffer-language guess-language-identified-alist)))
    (when action
      (funcall (cdr action)))))

(defun guess-language-timer-fn (buffer)
  (with-current-buffer buffer
    (setq buffer-language (guess-language-buffer))
    (when buffer-language
      (guess-language-call-handler))))

(define-minor-mode guess-language-mode
  "Execute actions based on buffer's language"
  :lighter (:eval (format " g:%s" (or buffer-language "?")))
  (if guess-language-mode
      (progn
        (setq buffer-language (guess-language-buffer))
        (if buffer-language
            (guess-language-call-handler)
          (progn
            (setq guess-language-timer
                  (run-at-time 10 10 'guess-language-timer-fn (current-buffer)))
            (add-hook 'kill-buffer-hook
                      (lambda ()
                        (when guess-language-timer
                          (cancel-timer guess-language-timer))) t t))))
    (when guess-language-timer
      (cancel-timer guess-language-timer))))

;; auto-exec-mode for calling functions after save based on major mode

(defvar auto-exec-alist '()
  "Association list connecting modes to functions")

(defvar-local auto-exec-function nil)

(define-minor-mode auto-exec-mode
  "Mode for automatically running commands on save based on major mode"
  :lighter " exec"
  (if auto-exec-mode
      (let ((action (assq major-mode auto-exec-alist)))
        (if action
            (progn
              (setq auto-exec-function (cdr action))
              (add-hook 'after-save-hook auto-exec-function t t))
          (error "No auto-exec command is associated with %s" major-mode)))
    (remove-hook 'after-save-hook auto-exec-function t)))

;; Programming mode

(defun prog-mode-defaults ()
  (fic-mode)
  (electric-pair-mode)
  (rainbow-delimiters-mode))

(add-hooks 'prog-mode-hook 'prog-mode-defaults
           'ielm-mode-hook 'prog-mode-defaults
           'comint-mode-hook 'prog-mode-defaults)

;; wcheck-mode with enchant and voikko

(when (deps "enchant")
  (defvar finnish-syntax-table
    (copy-syntax-table text-mode-syntax-table))

  (modify-syntax-entry ?- "w" finnish-syntax-table)

  (setq wcheck-language-data
        '(("Finnish"
           (program . "/usr/bin/enchant")
           (args "-l" "-d" "fi")
           (syntax . finnish-syntax-table)
           (action-program . "/usr/bin/enchant")
           (action-args "-a" "-d" "fi")
           (action-parser . wcheck-parser-ispell-suggestions)))))

;; Text mode

(add-to-list 'guess-language-identified-alist
             '(en . (lambda ()
                      (flyspell-mode)
                      (writegood-mode))))

(add-to-list 'guess-language-identified-alist
             '(fi . (lambda ()
                      (when (deps "enchant")
                        (wcheck-mode)
                        (setq wcheck-language "Finnish")))))


(require 'wc-mode)
(defun text-mode-defaults ()
  (guess-language-mode)
  (auto-fill-mode)
  (hl-line-mode)
  (wc-mode))

(add-hook 'text-mode-hook 'text-mode-defaults)

;; Markdown mode

(defun markdown-mode-defaults ()
  (text-scale-set 1))

(add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode))

(require 'markdown-mode)

(with-eval-after-load "markdown-mode"
  ;; Increase header sizes
  (setq markdown-bold-underscore t
        markdown-enable-math t
        markdown-command "pandoc")
  (add-hook 'markdown-mode-hook 'markdown-mode-defaults)
  (cl-loop for i from 1 to 6
           do (set-face-attribute
               (intern (format "markdown-header-face-%d" i)) nil :height (+ 1.0 (/ 1.0 i))))
  (set-face-attribute 'markdown-blockquote-face nil :slant 'italic))

;; TODO: add support for options from file-local variables
(defun pandoc-pdf-from-buffer ()
  (interactive)
  (let* ((name (file-name-base buffer-file-name))
         (dir (file-name-directory buffer-file-name))
         (output (concat (file-name-as-directory dir) name ".pdf"))
         (proc (start-process "pandoc-process" "*Pandoc-Log*" "pandoc" "-o" output "-f" "markdown")))
    (message "Pandoc: %s" output)
    (process-send-string proc (buffer-string))
    (process-send-eof proc)))

(when (deps "pandoc")
  (add-to-list 'auto-exec-alist '(markdown-mode . pandoc-pdf-from-buffer)))

;; Bibtex

(add-to-list 'auto-mode-alist '("\\.bibtex\\'" . bibtex-mode))

;; Lisp-like

(setq edebug-trace t)

(defun lisp-like-defaults ()
  (hl-sexp-mode)
  (aggressive-indent-mode)
  (enable-paredit-mode)
  (setq indent-tabs-mode nil
        tab-width 2))

(defun elisp-defaults ()
  (eldoc-mode)
  (bind-keys :map emacs-lisp-mode-map
             "C-c e" 'macrostep-expand))

(add-hooks 'lisp-mode-hook 'lisp-like-defaults
           'lisp-interaction-mode-hook 'lisp-like-defaults
           'emacs-lisp-mode-hook 'lisp-like-defaults
           'scheme-mode-hook 'lisp-like-defaults
           'clojure-mode-hook 'lisp-like-defaults)

(add-hooks 'emacs-lisp-mode-hook 'elisp-defaults)

(add-hooks 'lisp-interaction-mode-hook 'turn-on-eldoc-mode
           'ielm-mode-hook 'turn-on-eldoc-mode)

(eval-after-load "slime"
  (setq inferior-lisp-program "sbcl"))

(bind-keys "C-c i" 'ielm)

;; C-like languages

(require 'cc-mode)

(defun c-like-defaults ()
  (c-toggle-auto-newline 1)
  (c-toggle-hungry-state 1)
  (setq c-default-style "k&r"
        c-basic-offset 4
        indent-tabs-mode t
        tab-width 4))

(add-hook 'c-mode-common-hook 'c-like-defaults)
(add-hook 'c-initialization-hook
          (lambda () (bind-keys :map c-mode-map "C-c C-a" 'ff-find-other-file)))

;; Haskell

(require 'haskell-mode)
(require 'haskell-font-lock)

(defun haskell-mode-defaults ()
  (bind-keys :map haskell-mode-map
             "C-c h" 'hoogle
             "C-c l" 'haskell-process-load-or-reload)
  (setq haskell-interactive-popup-errors nil
        haskell-font-lock-symbols t)
  (turn-on-haskell-doc-mode)
  (turn-on-haskell-indentation))

(add-hook 'haskell-mode-hook 'haskell-mode-defaults)

;; Python

(require 'python)

(defun python-mode-defaults ()
  (eldoc-mode)
  (setq indent-tabs-mode t
        tab-width 4
        python-indent-offset 4))

(add-hook 'python-mode-hook 'python-mode-defaults)

;; Major mode for editing Portage's package files

(defconst portage-regex-disabled-use-flag
  "")

(defun portage-match-comment (last)
  nil)

(define-derived-mode portage-mode fundamental-mode "Portage"
  "A major mode for editing Portage's package files."
  (setq-local comment-start "# ")
  (setq-local comment-start-skip "#+\\s-*")
  (setq-local font-lock-defaults nil))

(add-to-list 'auto-mode-alist '("package.use\\'" . portage-mode))
(add-to-list 'auto-mode-alist '("package.accept_keywords\\'" . portage-mode))

;; Gentoo

(require 'site-gentoo nil t)

(require 'autoinsert)

(defun portage-known-licenses ()
  (let ((license-path "/usr/portage/licenses"))
    (if (file-exists-p license-path)
        (mapcar 'file-name-nondirectory
                (filter 'file-regular-p (directory-files license-path t)))
      '())))

(define-skeleton ebuild-skeleton
  "Template for ebuilds"
  ""
  "# Copyright 1999-" (format-time-string "%Y") " Gentoo Foundation\n"
  "# Distributed under the terms of the GNU General Public License v2\n"
  "# $Header: $\n\n"
  "EAPI=5\n\n"
  "DESCRIPTION=\"" (skeleton-read "Description: ") "\"\n"
  "HOMEPAGE=\"" (skeleton-read "Homepage: ") "\"\n"
  "SRC_URI=\"" (skeleton-read "URI: ") "\"\n"
  "LICENSE=\"" (completing-read "License: " (portage-known-licenses)) "\"\n"
  "SLOT=\"0\"\n"
  "KEYWORDS=\"~x86 ~amd64\"\n"
  "IUSE=\"\"\n\n"
  "DEPEND=\"""\"\n"
  "RDEPEND=\"${DEPEND}\"\n\n" _)

(add-to-list 'auto-mode-alist '("\\.ebuild\\'" . sh-mode))
(add-hook 'find-file-hooks 'auto-insert)
(setq auto-insert-query nil)
(extend-list auto-insert-alist
             '(("\\.ebuild\\'" . ebuild-skeleton)))

;; GUD mode

(unless (deps "pdb")
  (setq gud-pdb-command-name "python -m pdb"))

;; HTML

(defun html-mode-defaults ()
  (setq-local sgml-basic-offset 4))

(add-hook 'html-mode-hook #'html-mode-defaults)

;; Org mode

(bind-keys "C-c o l" 'org-store-link
           "C-c o c" 'org-capture
           "C-c o a" 'org-agenda
           "C-c o b" 'org-iswitchb)

(setq org-directory "~/documents/org"
      org-default-notes-file "~/documents/org/notes.org"
      org-M-RET-may-split-line nil
      org-html-doctype "xhtml5")

(setq org-capture-templates
      '(("n" "Note" entry (file+datetree "")
         "* %^{Title}\n\n%?")))

;; Google Translate

(require 'google-translate)

(setq google-translate-default-source-language "fi"
      google-translate-default-target-language "en"
      google-translate-output-destination 'echo-area)

(defun google-translate-with-defaults (d)
  "Query Google Translate with default languages.
Reverses the direction if universal argument is supplied."
  (interactive "P")
  (if d
      (google-translate-query-translate-reverse)
    (google-translate-query-translate)))

(bind-keys "C-c t" 'google-translate-with-defaults)

;; Notmuch

(when (package-installed-p 'notmuch)
  (require 'notmuch)
  (require 'notmuch-show)
  (setq notmuch-search-oldest-first nil
        notmuch-crypto-process-mime t)
  (bind-keys "C-c n a" (active (partial notmuch-search "tag:inbox" nil))
             "C-c n u" (active (partial notmuch-search "tag:unread" nil))
             "C-c n s" 'notmuch-search
             "C-c n m" 'notmuch-mua-mail)
  (bind-keys :map notmuch-show-mode-map
             "J" 'evil-scroll-down
             "K" 'evil-scroll-up)
  (when (deps "notmuch-addrlookup")
    (require 'notmuch-address)
    (setq notmuch-address-command "notmuch-addrlookup")
    (notmuch-address-message-insinuate)
    (setq notmuch-address-selection-function
          (lambda (prompt collection initial-input)
            (completing-read prompt (cons initial-input collection) nil t nil 'notmuch-address-history)))))

(require 'smtpmail)

(setq smtpmail-stream-type 'ssl
      smtpmail-smtp-server "smtp.gmail.com"
      smtpmail-smtp-service 465)

(add-hook 'message-setup-hook 'mml-secure-sign-pgpmime)

;; TRAMP mode

(setq tramp-default-method "ssh")

;; Various Web things

(add-hook 'css-mode-hook 'rainbow-mode)
(add-hook 'html-mode-hook 'rainbow-mode)

;; Flycheck mode

(require 'flycheck)

(global-flycheck-mode)
(setq-default flycheck-disabled-checkers '(emacs-lisp-checkdoc))
(add-hook 'flycheck-mode-hook 'flycheck-haskell-setup)

(setq flycheck-mode-line
      '(:eval
        (if (eq flycheck-last-status-change 'no-checker)
            ""
          (flycheck-mode-line-status-text))))

;; Compilation desktop notifications

(require 'notifications)

(add-to-list 'compilation-finish-functions
             (lambda (_ description)
               (notifications-notify
                :title "Compilation finished"
                :body description
                :urgency 'low)))

;; Emoji picker for Helm

(defconst helm-emoji-ranges
  '((#x1F300 . #x1F5FF) ; Miscellaneous Symbols and Pictograms
    (#x1F600 . #x1F64F) ; Emoticons
    (#x1F680 . #x1F6F3) ; Transport and Map Symbols
    (#x2600  . #x26FF)  ; Miscellaneous Symbols
    (#x2700  . #x27BF)) ; Dingbats
  "Code point ranges that contain emoji characters")

(defvar helm-emoji-cache nil)

(defface helm-emoji-emoji-face
  '((t . (:foreground "blue")))
  "Face used for displaying emoji"
  :group 'helm)

(defface helm-emoji-name-face
  '((t . (:foreground "gray")))
  "Face used for displaying names of emoji"
  :group 'helm)

(defun helm-emoji-range (start stop)
  (cl-loop for i from start to stop
           when (get-char-code-property i 'name)
           collect (cons
                    (format "%s %s"
                            (propertize (char-to-string i) 'face 'helm-emoji-emoji-face)
                            (propertize it 'face 'helm-emoji-name-face))
                    i)))

(defvar helm-source-emoji
  '((name . "Emoji")
    (candidates . (lambda ()
                    (unless helm-emoji-cache
                      (setq helm-emoji-cache
                            (apply #'cl-concatenate 'list
                                   (cl-loop for (start . stop) in helm-emoji-ranges
                                            collect (helm-emoji-range start stop)))))
                    helm-emoji-cache))
    (action . insert)))

(defun helm-emoji ()
  (interactive)
  (helm-other-buffer 'helm-source-emoji nil))

(bind-keys "C-x c E" #'helm-emoji)

;; Weechat

(with-eval-after-load "weechat"
  (extend-list weechat-modules '(weechat-notifications))
  (set-face-attribute 'weechat-time-face nil :foreground "light grey")
  (bind-keys :map weechat-mode-map
             "C-c SPC" #'helm-weechat-buffers)
  (setq weechat-time-format "%H:%M"
        weechat-text-column 0
        weechat-header-line-format "%t"
        weechat-auto-monitor-buffers t
        weechat-color-list '("dark green" "dark red" "dark orange"
                             "royal blue" "dark magenta" "purple"
                             "yellow green" "dodger blue" "violet"
                             "goldenrod" "tomato" "red1"
                             "SpringGreen1" "gold" "lime green"
                             "VioletRed2" "OliveDrab4" "maroon1"
                             "turquoise" "orchid" "lawn green")))

(defun weechat-connect-default ()
  (interactive)
  (weechat-connect))

(defface helm-weechat-channel
  '((t . (:foreground "dark green" :weight bold)))
  "Face used for channel buffers"
  :group 'helm)

(defface helm-weechat-server
  '((t . (:foreground "grey")))
  "Face used for server buffers"
  :group 'helm)

(defun helm-weechat-format-buffer (buffer)
  (let* ((sub (split-string (buffer-name buffer) "\\."))
         (is-server (or (equal (car sub) "server")
                        (equal (car sub) "weechat")))
         (name (string-join (if (cdr sub) (cdr sub) sub)))
         (face (if is-server 'helm-weechat-server 'helm-weechat-channel)))
    (cons
     (propertize name 'face face)
     buffer)))

(defvar helm-source-weechat
  '((name . "WeeChat")
    (candidates . (lambda ()
                    (mapcar #'helm-weechat-format-buffer (weechat-buffer-list))))
    (action . switch-to-buffer-dwim)))

(defun helm-weechat-buffers ()
  (interactive)
  (helm-other-buffer 'helm-source-weechat nil))

(bind-keys "C-x c w" #'helm-weechat-buffers)

;; Window management

(require 'transpose-frame)

(defun switch-window-or-buffer ()
  "Switch window or buffer depending on the number of windows"
  (interactive)
  (if (other-windows?)
      (other-window 1)
    (switch-to-buffer (other-buffer))))

(defun swap-with-largest ()
  "Swap the current window's buffer with the largest window. The largest window is then selected."
  (interactive)
  (let* ((current-win (selected-window))
         (current-buf (window-buffer current-win))
         (largest-win (get-largest-window))
         (largest-buf (window-buffer largest-win)))
    (set-window-buffer largest-win current-buf)
    (set-window-buffer current-win largest-buf)
    (select-window largest-win)))

;; Hmm, this might not be the best way to do this
(define-minor-mode pinned-mode
  "Pin buffer to window"
  :lighter " P"
  (set-window-dedicated-p (selected-window) pinned-mode))

(bind-keys "C-c w z" #'zoom-window-zoom
           "C-c w m" #'swap-with-largest
           "C-c w r" (repeating "r" #'rotate-frame-clockwise)
           "C-c w p" #'pinned-mode
           "C-<tab>" #'switch-window-or-buffer
           "C-x o" (repeating "o" #'switch-window-or-buffer))

(setq zoom-window-mode-line-color "lime green")

(defun set-frame-alpha (number)
  (interactive "nAlpha: ")
  (if (<= 10 number 100)
      (set-frame-parameter nil 'alpha number)
    (error "Invalid alpha")))

;; Fullscreen support

(defun toggle-fullscreen ()
  (interactive)
  (x-send-client-message nil 0 nil "_NET_WM_STATE" 32
                         '(2 "_NET_WM_STATE_FULLSCREEN" 0)))

(bind-keys "<f11>" 'toggle-fullscreen)

;; Byte compile the init file after saving
;; This is little problematic if the init file is edited outside of emacs

(defun byte-compile-init ()
  (when (string-equal buffer-file-name (file-truename user-init-file))
    (byte-compile-file user-init-file)))

(add-hook 'after-save-hook 'byte-compile-init)

;; Diminish

(defmacro diminish-all (&rest modes)
  "Hide minor modes from the mode line"
  `(progn
     ,@(mapcar (lambda (m)
                 (cl-multiple-value-bind (file mode)
                     (if (listp m)
                         (values (car m) (cdr m))
                       (values m (intern (concat (symbol-name m) "-mode"))))
                   `(with-eval-after-load ,(symbol-name file) (diminish (quote ,mode)))))
               modes)))

(diminish 'schedule-events-mode)

(diminish-all helm
              eldoc
              undo-tree
              auto-complete
              paredit
              aggressive-indent
              auto-fill
              (subword . superword-mode)
              (fic-mode . fic-mode)
              (rainbow-mode . rainbow-mode))

;; Evil mode

(require 'evil)

(setq evil-default-cursor t
      evil-cross-lines t)

(evil-mode)

(setq evil-disabled-modes
      '(inferior-emacs-lisp-mode
        inferior-haskell-mode
        inferior-python-mode
        geiser-repl-mode
        comint-mode
        artist-mode
        eshell-mode
        haskell-interactive-mode
        dired-mode
        term-mode
        doctor-mode
        weechat-mode
        tetris-mode
        snake-mode))

(mapc (partial evil-set-initial-state _ 'emacs) evil-disabled-modes)

(bind-keys :map evil-visual-state-map
           "\\" 'comment-dwim)

(defun comment-toggle-line ()
  (interactive)
  (comment-or-uncomment-region (line-beginning-position) (line-end-position)))

(bind-keys :map evil-normal-state-map
           "j" 'evil-next-visual-line
           "k" 'evil-previous-visual-line
           "J" 'evil-scroll-down
           "K" 'evil-scroll-up
           "\\" 'comment-toggle-line
           "<return>" 'er/expand-region
           "C-c +" 'evil-numbers/inc-at-pt
           "C-c -" 'evil-numbers/dec-at-pt)