;;; clojure-mode.el --- Major mode for Clojure code

;; Copyright (C) 2007-2011 Jeffrey Chu, Lennart Staflin, Phil Hagelberg

;;

;; Authors: Jeffrey Chu <[email protected]>

;;          Lennart Staflin <[email protected]>

;;          Phil Hagelberg <[email protected]>

;; URL: http://github.com/technomancy/clojure-mode

;; Version: 1.11.5

;; Keywords: languages, lisp

;; This file is not part of GNU Emacs.

;;; Commentary:

;; Provides font-lock, indentation, and navigation for the Clojure

;; language. (http://clojure.org)

;; Users of older Emacs (pre-22) should get version 1.4:

;; http://github.com/technomancy/clojure-mode/tree/1.4

;;; Installation:

;; Use package.el. You'll need to add Marmalade to your archives:

;; (require 'package)

;; (add-to-list 'package-archives

;;              '("marmalade" . "http://marmalade-repo.org/packages/"))

;; If you use a version of Emacs prior to 24 that doesn't include

;; package.el, you can get it from http://bit.ly/pkg-el23. If you have

;; an older package.el installed from tromey.com, you should upgrade

;; in order to support installation from multiple sources.

;; Of course, it's possible to just place it on your load-path and

;; require it as well if you don't mind missing out on

;; byte-compilation and autoloads.

;; Using clojure-mode with paredit is highly recommended. It is also

;; available using package.el from the above archive.

;; Use paredit as you normally would with any other mode; for instance:

;;

;;   ;; require or autoload paredit-mode

;;   (defun turn-on-paredit () (paredit-mode 1))

;;   (add-hook 'clojure-mode-hook 'turn-on-paredit)

;; See Swank Clojure (http://github.com/technomancy/swank-clojure) for

;; better interaction with subprocesses via SLIME.

;;; License:

;; This program is free software; you can redistribute it and/or

;; modify it under the terms of the GNU General Public License

;; as published by the Free Software Foundation; either version 3

;; of the License, or (at your option) any later version.

;;

;; This program is distributed in the hope that it will be useful,

;; but WITHOUT ANY WARRANTY; without even the implied warranty of

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;; GNU General Public License for more details.

;;

;; You should have received a copy of the GNU General Public License

;; along with GNU Emacs; see the file COPYING.  If not, write to the

;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,

;; Boston, MA 02110-1301, USA.

;;; Code:

(require 'cl)

(defgroup clojure-mode nil

  "A mode for Clojure"

  :prefix "clojure-mode-"

  :group 'applications)

(defcustom clojure-mode-font-lock-comment-sexp nil

  "Set to non-nil in order to enable font-lock of (comment...)

forms. This option is experimental. Changing this will require a

restart (ie. M-x clojure-mode) of existing clojure mode buffers."

  :type 'boolean

  :group 'clojure-mode)

(defcustom clojure-mode-load-command  "(clojure.core/load-file \"%s\")\n"

  "*Format-string for building a Clojure expression to load a file.

This format string should use `%s' to substitute a file name

and should result in a Clojure expression that will command the inferior

Clojure to load that file."

  :type 'string

  :group 'clojure-mode)

(defcustom clojure-mode-use-backtracking-indent t

  "Set to non-nil to enable backtracking/context sensitive indentation."

  :type 'boolean

  :group 'clojure-mode)

(defcustom clojure-max-backtracking 3

  "Maximum amount to backtrack up a list to check for context."

  :type 'integer

  :group 'clojure-mode)

(defvar clojure-mode-map

  (let ((map (make-sparse-keymap)))

    (set-keymap-parent map lisp-mode-shared-map)

    (define-key map "\e\C-x" 'lisp-eval-defun)

    (define-key map "\C-x\C-e" 'lisp-eval-last-sexp)

    (define-key map "\C-c\C-e" 'lisp-eval-last-sexp)

    (define-key map "\C-c\C-l" 'clojure-load-file)

    (define-key map "\C-c\C-r" 'lisp-eval-region)

    (define-key map "\C-c\C-z" 'clojure-display-inferior-lisp-buffer)

    (define-key map (kbd "RET") 'reindent-then-newline-and-indent)

    (define-key map (kbd "C-c t") 'clojure-jump-to-test)

    (define-key map (kbd "C-c M-q") 'clojure-fill-docstring)

    map)

  "Keymap for Clojure mode. Inherits from `lisp-mode-shared-map'.")

(defvar clojure-mode-syntax-table

  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))

    (modify-syntax-entry ?~ "'   " table)

    ;; can't safely make commas whitespace since it will apply even

    ;; inside string literals--ick!

    ;; (modify-syntax-entry ?, "    " table)

    (modify-syntax-entry ?\{ "(}" table)

    (modify-syntax-entry ?\} "){" table)

    (modify-syntax-entry ?\[ "(]" table)

    (modify-syntax-entry ?\] ")[" table)

    (modify-syntax-entry ?^ "'" table)

    table))

(defvar clojure-mode-abbrev-table nil

  "Abbrev table used in clojure-mode buffers.")

(define-abbrev-table 'clojure-mode-abbrev-table ())

(defvar clojure-prev-l/c-dir/file nil

  "Record last directory and file used in loading or compiling.

This holds a cons cell of the form `(DIRECTORY . FILE)'

describing the last `clojure-load-file' or `clojure-compile-file' command.")

(defvar clojure-test-ns-segment-position -1

  "Which segment of the ns is \"test\" inserted in your test name convention.

Customize this depending on your project's conventions. Negative

numbers count from the end:

  leiningen.compile -> leiningen.test.compile (uses 1)

  clojure.http.client -> clojure.http.test.client (uses -1)")

(defun clojure-mode-version ()

  "Currently package.el doesn't support prerelease version numbers."

  "1.11.5")

;;;###autoload

(defun clojure-mode ()

  "Major mode for editing Clojure code - similar to Lisp mode.

Commands:

Delete converts tabs to spaces as it moves back.

Blank lines separate paragraphs.  Semicolons start comments.

\\{clojure-mode-map}

Note that `run-lisp' may be used either to start an inferior Lisp job

or to switch back to an existing one.

Entry to this mode calls the value of `clojure-mode-hook'

if that value is non-nil."

  (interactive)

  (kill-all-local-variables)

  (use-local-map clojure-mode-map)

  (setq mode-name "Clojure"

        major-mode 'clojure-mode

        imenu-create-index-function

        (lambda ()

          (imenu--generic-function '((nil clojure-match-next-def 0))))

        local-abbrev-table clojure-mode-abbrev-table

        indent-tabs-mode nil)

  (lisp-mode-variables nil)

  (set-syntax-table clojure-mode-syntax-table)

  (set (make-local-variable 'comment-start-skip)

       "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")

  (set (make-local-variable 'lisp-indent-function)

       'clojure-indent-function)

  (when (< emacs-major-version 24)

    (set (make-local-variable 'forward-sexp-function)

         'clojure-forward-sexp))

  (set (make-local-variable 'lisp-doc-string-elt-property)

       'clojure-doc-string-elt)

  (set (make-local-variable 'inferior-lisp-program) "lein repl")

  (set (make-local-variable 'parse-sexp-ignore-comments) t)

  (clojure-mode-font-lock-setup)

  (run-mode-hooks 'clojure-mode-hook)

  (run-hooks 'prog-mode-hook)

  ;; Enable curly braces when paredit is enabled in clojure-mode-hook

  (when (and (featurep 'paredit) paredit-mode (>= paredit-version 21))

    (define-key clojure-mode-map "{" 'paredit-open-curly)

    (define-key clojure-mode-map "}" 'paredit-close-curly)))

(defun clojure-display-inferior-lisp-buffer ()

  "Display a buffer bound to `inferior-lisp-buffer'."

  (interactive)

  (if (and inferior-lisp-buffer (get-buffer inferior-lisp-buffer))

      (pop-to-buffer inferior-lisp-buffer t)

      (run-lisp inferior-lisp-program)))

(defun clojure-load-file (file-name)

  "Load a Lisp file into the inferior Lisp process."

  (interactive (comint-get-source "Load Clojure file: "

                                  clojure-prev-l/c-dir/file

                                  '(clojure-mode) t))

  (comint-check-source file-name) ; Check to see if buffer needs saved.

  (setq clojure-prev-l/c-dir/file (cons (file-name-directory file-name)

                                        (file-name-nondirectory file-name)))

  (comint-send-string (inferior-lisp-proc)

                      (format clojure-mode-load-command file-name))

  (switch-to-lisp t))

(defun clojure-match-next-def ()

  "Scans the buffer backwards for the next top-level definition.

Called by `imenu--generic-function'."

  (when (re-search-backward "^\\s *(def\\S *[ \n\t]+" nil t)

    (save-excursion

      (goto-char (match-end 0))

      (when (looking-at "#?\\^")

        (let (forward-sexp-function) ; using the built-in one

          (forward-sexp)))           ; skip the metadata

      (re-search-forward "[^ \n\t)]+"))))

(defun clojure-mode-font-lock-setup ()

  "Configures font-lock for editing Clojure code."

  (interactive)

  (set (make-local-variable 'font-lock-multiline) t)

  (add-to-list 'font-lock-extend-region-functions

               'clojure-font-lock-extend-region-def t)

  (when clojure-mode-font-lock-comment-sexp

    (add-to-list 'font-lock-extend-region-functions

                 'clojure-font-lock-extend-region-comment t)

    (make-local-variable 'clojure-font-lock-keywords)

    (add-to-list 'clojure-font-lock-keywords

                 'clojure-font-lock-mark-comment t)

    (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil))

  (setq font-lock-defaults

        '(clojure-font-lock-keywords    ; keywords

          nil nil

          (("+-*/.<>=!?$%_&~^:@" . "w")) ; syntax alist

          nil

          (font-lock-mark-block-function . mark-defun)

          (font-lock-syntactic-face-function

           . lisp-font-lock-syntactic-face-function))))

(defun clojure-font-lock-def-at-point (point)

  "Find the position range between the top-most def* and the

fourth element afterwards. Note that this means there's no

gaurantee of proper font locking in def* forms that are not at

top-level."

  (goto-char point)

  (condition-case nil

      (beginning-of-defun)

    (error nil))

  (let ((beg-def (point)))

    (when (and (not (= point beg-def))

               (looking-at "(def"))

      (condition-case nil

          (progn

            ;; move forward as much as possible until failure (or success)

            (forward-char)

            (dotimes (i 4)

              (forward-sexp)))

        (error nil))

      (cons beg-def (point)))))

(defun clojure-font-lock-extend-region-def ()

  "Move fontification boundaries to always include the first four

elements of a def* forms."

  (let ((changed nil))

    (let ((def (clojure-font-lock-def-at-point font-lock-beg)))

      (when def

        (destructuring-bind (def-beg . def-end) def

          (when (and (< def-beg font-lock-beg)

                     (< font-lock-beg def-end))

            (setq font-lock-beg def-beg

                  changed t)))))

    (let ((def (clojure-font-lock-def-at-point font-lock-end)))

      (when def

        (destructuring-bind (def-beg . def-end) def

          (when (and (< def-beg font-lock-end)

                     (< font-lock-end def-end))

            (setq font-lock-end def-end

                  changed t)))))

    changed))

(defun clojure-font-lock-extend-region-comment ()

  "Move fontification boundaries to always contain

  entire (comment ..) sexp. Does not work if you have a

  white-space between ( and comment, but that is omitted to make

  this run faster."

  (let ((changed nil))

    (goto-char font-lock-beg)

    (condition-case nil (beginning-of-defun) (error nil))

    (let ((pos (re-search-forward "(comment\\>" font-lock-end t)))

      (when pos

        (forward-char -8)

        (when (< (point) font-lock-beg)

          (setq font-lock-beg (point)

                changed t))

        (condition-case nil (forward-sexp) (error nil))

        (when (> (point) font-lock-end)

          (setq font-lock-end (point)

                changed t))))

    changed))

(defun clojure-font-lock-mark-comment (limit)

  "Marks all (comment ..) forms with font-lock-comment-face."

  (let (pos)

    (while (and (< (point) limit)

                (setq pos (re-search-forward "(comment\\>" limit t)))

      (when pos

        (forward-char -8)

        (condition-case nil

            (add-text-properties (1+ (point)) (progn

                                                (forward-sexp) (1- (point)))

                                 '(face font-lock-comment-face multiline t))

          (error (forward-char 8))))))

  nil)

(defconst clojure-font-lock-keywords

  (eval-when-compile

    `( ;; Definitions.

      (,(concat "(\\(?:clojure.core/\\)?\\("

                (regexp-opt '("defn" "defn-" "def" "def-" "defonce"

                              "defmulti" "defmethod" "defmacro"

                              "defstruct" "deftype" "defprotocol"

                              "defrecord" "deftest"

                              "slice" "def\\[a-z\\]"

                              "defalias" "defhinted" "defmacro-"

                              "defn-memo" "defnk" "defonce-"

                              "defstruct-" "defunbound" "defunbound-"

                              "defvar" "defvar-"))

                ;; Function declarations.

                "\\)\\>"

                ;; Any whitespace

                "[ \r\n\t]*"

                ;; Possibly type or metadata

                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"

                "\\(\\sw+\\)?")

       (1 font-lock-keyword-face)

       (2 font-lock-function-name-face nil t))

      ;; Deprecated functions

      (,(concat

         "(\\(?:clojure.core/\\)?"

         (regexp-opt

          '("add-watcher" "remove-watcher" "add-classpath") t)

         "\\>")

       1 font-lock-warning-face)

      ;; Control structures

      (,(concat

         "(\\(?:clojure.core/\\)?"

         (regexp-opt

          '("let" "letfn" "do"

            "case" "cond" "condp"

            "for" "loop" "recur"

            "when" "when-not" "when-let" "when-first"

            "if" "if-let" "if-not"

            "." ".." "->" "->>" "doto"

            "and" "or"

            "dosync" "doseq" "dotimes" "dorun" "doall"

            "load" "import" "unimport" "ns" "in-ns" "refer"

            "try" "catch" "finally" "throw"

            "with-open" "with-local-vars" "binding"

            "gen-class" "gen-and-load-class" "gen-and-save-class"

            "handler-case" "handle") t)

         "\\>")

       1 font-lock-builtin-face)

      ;; Built-ins

      (,(concat

         "(\\(?:clojure.core/\\)?"

         (regexp-opt

          '("*" "*1" "*2" "*3" "*agent*"

        "*allow-unresolved-vars*" "*assert*" "*clojure-version*" "*command-line-args*" "*compile-files*"

        "*compile-path*" "*e" "*err*" "*file*" "*flush-on-newline*"

        "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*"

        "*print-dup*" "*print-length*" "*print-level*" "*print-meta*" "*print-readably*"

        "*read-eval*" "*source-path*" "*use-context-classloader*" "*warn-on-reflection*" "+"

        "-" "/"

        "<" "<=" "=" "==" ">"

        ">=" "accessor" "aclone"

        "agent" "agent-errors" "aget" "alength" "alias"

        "all-ns" "alter" "alter-meta!" "alter-var-root" "amap"

        "ancestors" "and" "apply" "areduce" "array-map"

        "aset" "aset-boolean" "aset-byte" "aset-char" "aset-double"

        "aset-float" "aset-int" "aset-long" "aset-short" "assert"

        "assoc" "assoc!" "assoc-in" "associative?" "atom"

        "await" "await-for" "await1" "bases" "bean"

        "bigdec" "bigint" "binding" "bit-and" "bit-and-not"

        "bit-clear" "bit-flip" "bit-not" "bit-or" "bit-set"

        "bit-shift-left" "bit-shift-right" "bit-test" "bit-xor" "boolean"