diff -r 942fe8d1a653 -r 6590d340a568 thirdparty/clojure-mode.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thirdparty/clojure-mode.el Thu Mar 01 17:25:13 2012 -0600 @@ -0,0 +1,1199 @@ +;;; clojure-mode.el --- Major mode for Clojure code + +;; Copyright (C) 2007-2011 Jeffrey Chu, Lennart Staflin, Phil Hagelberg +;; +;; Authors: Jeffrey Chu +;; Lennart Staflin +;; Phil Hagelberg +;; 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" + "boolean-array" "booleans" "bound-fn" "bound-fn*" "butlast" + "byte" "byte-array" "bytes" "case" "cast" "char" + "char-array" "char-escape-string" "char-name-string" "char?" "chars" + "chunk" "chunk-append" "chunk-buffer" "chunk-cons" "chunk-first" + "chunk-next" "chunk-rest" "chunked-seq?" "class" "class?" + "clear-agent-errors" "clojure-version" "coll?" "comment" "commute" + "comp" "comparator" "compare" "compare-and-set!" "compile" + "complement" "concat" "cond" "condp" "conj" + "conj!" "cons" "constantly" "construct-proxy" "contains?" + "count" "counted?" "create-ns" "create-struct" "cycle" + "dec" "decimal?" "declare" "definline" "defmacro" + "defmethod" "defmulti" "defn" "defn-" "defonce" + "defstruct" "delay" "delay?" "deliver" "deref" + "derive" "descendants" "destructure" "disj" "disj!" + "dissoc" "dissoc!" "distinct" "distinct?" "doall" + "doc" "dorun" "doseq" "dosync" "dotimes" + "doto" "double" "double-array" "doubles" "drop" + "drop-last" "drop-while" "empty" "empty?" "ensure" + "enumeration-seq" "eval" "even?" "every?" + "extend" "extend-protocol" "extend-type" "extends?" "extenders" + "false?" "ffirst" "file-seq" "filter" "find" "find-doc" + "find-ns" "find-var" "first" "flatten" "float" "float-array" + "float?" "floats" "flush" "fn" "fn?" + "fnext" "for" "force" "format" "future" + "future-call" "future-cancel" "future-cancelled?" "future-done?" "future?" + "gen-class" "gen-interface" "gensym" "get" "get-in" + "get-method" "get-proxy-class" "get-thread-bindings" "get-validator" "hash" + "hash-map" "hash-set" "identical?" "identity" "if-let" + "if-not" "ifn?" "import" "in-ns" "inc" + "init-proxy" "instance?" "int" "int-array" "integer?" + "interleave" "intern" "interpose" "into" "into-array" + "ints" "io!" "isa?" "iterate" "iterator-seq" + "juxt" "key" "keys" "keyword" "keyword?" + "last" "lazy-cat" "lazy-seq" "let" "letfn" + "line-seq" "list" "list*" "list?" "load" + "load-file" "load-reader" "load-string" "loaded-libs" "locking" + "long" "long-array" "longs" "loop" "macroexpand" + "macroexpand-1" "make-array" "make-hierarchy" "map" "map?" + "mapcat" "max" "max-key" "memfn" "memoize" + "merge" "merge-with" "meta" "method-sig" "methods" + "min" "min-key" "mod" "name" "namespace" + "neg?" "newline" "next" "nfirst" "nil?" + "nnext" "not" "not-any?" "not-empty" "not-every?" + "not=" "ns" "ns-aliases" "ns-imports" "ns-interns" + "ns-map" "ns-name" "ns-publics" "ns-refers" "ns-resolve" + "ns-unalias" "ns-unmap" "nth" "nthnext" "num" + "number?" "odd?" "or" "parents" "partial" + "partition" "pcalls" "peek" "persistent!" "pmap" + "pop" "pop!" "pop-thread-bindings" "pos?" "pr" + "pr-str" "prefer-method" "prefers" "primitives-classnames" "print" + "print-ctor" "print-doc" "print-dup" "print-method" "print-namespace-doc" + "print-simple" "print-special-doc" "print-str" "printf" "println" + "println-str" "prn" "prn-str" "promise" "proxy" + "proxy-call-with-super" "proxy-mappings" "proxy-name" "proxy-super" "push-thread-bindings" + "pvalues" "quot" "rand" "rand-int" "range" + "ratio?" "rational?" "rationalize" "re-find" "re-groups" + "re-matcher" "re-matches" "re-pattern" "re-seq" "read" + "read-line" "read-string" "reify" "reduce" "ref" "ref-history-count" + "ref-max-history" "ref-min-history" "ref-set" "refer" "refer-clojure" + "release-pending-sends" "rem" "remove" "remove-method" "remove-ns" + "repeat" "repeatedly" "replace" "replicate" + "require" "reset!" "reset-meta!" "resolve" "rest" + "resultset-seq" "reverse" "reversible?" "rseq" "rsubseq" + "satisfies?" "second" "select-keys" "send" "send-off" "seq" + "seq?" "seque" "sequence" "sequential?" "set" + "set-validator!" "set?" "short" "short-array" "shorts" + "shutdown-agents" "slurp" "some" "sort" "sort-by" + "sorted-map" "sorted-map-by" "sorted-set" "sorted-set-by" "sorted?" + "special-form-anchor" "special-symbol?" "split-at" "split-with" "str" + "stream?" "string?" "struct" "struct-map" "subs" + "subseq" "subvec" "supers" "swap!" "symbol" + "symbol?" "sync" "syntax-symbol-anchor" "take" "take-last" + "take-nth" "take-while" "test" "the-ns" "time" + "to-array" "to-array-2d" "trampoline" "transient" "tree-seq" + "true?" "type" "unchecked-add" "unchecked-dec" "unchecked-divide" + "unchecked-inc" "unchecked-multiply" "unchecked-negate" "unchecked-remainder" "unchecked-subtract" + "underive" "unquote" "unquote-splicing" "update-in" "update-proxy" + "use" "val" "vals" "var-get" "var-set" + "var?" "vary-meta" "vec" "vector" "vector?" + "when" "when-first" "when-let" "when-not" "while" + "with-bindings" "with-bindings*" "with-in-str" "with-loading-context" "with-local-vars" + "with-meta" "with-open" "with-out-str" "with-precision" "xml-seq" "zipmap" + ) t) + "\\>") + 1 font-lock-variable-name-face) + ;; (fn name? args ...) + (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+" + ;; Possibly type + "\\(?:#?^\\sw+[ \t]*\\)?" + ;; Possibly name + "\\(\\sw+\\)?" ) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face nil t)) + ;;Other namespaces in clojure.jar + (,(concat + "(\\(?:\.*/\\)?" + (regexp-opt + '(;; clojure.inspector + "atom?" "collection-tag" "get-child" "get-child-count" "inspect" + "inspect-table" "inspect-tree" "is-leaf" "list-model" "list-provider" + ;; clojure.main + "load-script" "main" "repl" "repl-caught" "repl-exception" + "repl-prompt" "repl-read" "skip-if-eol" "skip-whitespace" "with-bindings" + ;; clojure.set + "difference" "index" "intersection" "join" "map-invert" + "project" "rename" "rename-keys" "select" "union" + ;; clojure.stacktrace + "e" "print-cause-trace" "print-stack-trace" "print-throwable" "print-trace-element" + ;; clojure.template + "do-template" "apply-template" + ;; clojure.test + "*initial-report-counters*" "*load-tests*" "*report-counters*" "*stack-trace-depth*" "*test-out*" + "*testing-contexts*" "*testing-vars*" "are" "assert-any" "assert-expr" + "assert-predicate" "compose-fixtures" "deftest" "deftest-" "file-position" + "function?" "get-possibly-unbound-var" "inc-report-counter" "is" "join-fixtures" + "report" "run-all-tests" "run-tests" "set-test" "successful?" + "test-all-vars" "test-ns" "test-var" "testing" "testing-contexts-str" + "testing-vars-str" "try-expr" "use-fixtures" "with-test" "with-test-out" + ;; clojure.walk + "keywordize-keys" "macroexpand-all" "postwalk" "postwalk-demo" "postwalk-replace" + "prewalk" "prewalk-demo" "prewalk-replace" "stringify-keys" "walk" + ;; clojure.xml + "*current*" "*sb*" "*stack*" "*state*" "attrs" + "content" "content-handler" "element" "emit" "emit-element" + ;; clojure.zip + "append-child" "branch?" "children" "down" "edit" + "end?" "insert-child" "insert-left" "insert-right" "left" + "leftmost" "lefts" "make-node" "next" "node" + "path" "prev" "remove" "replace" "right" + "rightmost" "rights" "root" "seq-zip" "up" + ) t) + "\\>") + 1 font-lock-type-face) + ;; Constant values (keywords), including as metadata e.g. ^:static + ("\\<^?:\\(\\sw\\|#\\)+\\>" 0 font-lock-constant-face) + ;; Meta type annotation #^Type or ^Type + ("#?^\\sw+" 0 font-lock-type-face) + ("\\" 0 font-lock-warning-face) + + ;;Java interop highlighting + ("\\<\\.[a-z][a-zA-Z0-9]*\\>" 0 font-lock-preprocessor-face) ;; .foo .barBaz .qux01 + ("\\<[A-Z][a-zA-Z0-9]*/[a-zA-Z0-9/$_]+\\>" 0 font-lock-preprocessor-face) ;; Foo Bar$Baz Qux_ + ("\\<[a-zA-Z]+\\.[a-zA-Z0-9._]*[A-Z]+[a-zA-Z0-9/.$]*\\>" 0 font-lock-preprocessor-face) ;; Foo/Bar foo.bar.Baz foo.Bar/baz + ("[a-z]*[A-Z]+[a-z][a-zA-Z0-9$]*\\>" 0 font-lock-preprocessor-face) ;; fooBar + ("\\<[A-Z][a-zA-Z0-9$]*\\.\\>" 0 font-lock-preprocessor-face))) ;; Foo. BarBaz. Qux$Quux. Corge9. + + + "Default expressions to highlight in Clojure mode.") + +;; Docstring positions +(put 'defn 'clojure-doc-string-elt 2) +(put 'defn- 'clojure-doc-string-elt 2) +(put 'defmulti 'clojure-doc-string-elt 2) +(put 'defmacro 'clojure-doc-string-elt 2) +(put 'definline 'clojure-doc-string-elt 2) +(put 'defprotocol 'clojure-doc-string-elt 2) + +;; Docstring positions - contrib +(put 'defalias 'clojure-doc-string-elt 3) +(put 'defmacro- 'clojure-doc-string-elt 2) +(put 'defn-memo 'clojure-doc-string-elt 2) +(put 'defnk 'clojure-doc-string-elt 2) +(put 'defonce- 'clojure-doc-string-elt 3) +(put 'defunbound 'clojure-doc-string-elt 2) +(put 'defunbound- 'clojure-doc-string-elt 2) +(put 'defvar 'clojure-doc-string-elt 3) +(put 'defvar- 'clojure-doc-string-elt 3) + + + +(defun clojure-forward-sexp (n) + "Treat record literals like #user.Foo[1] and #user.Foo{:size 1} +as a single sexp so that slime will send them properly. Arguably +this behavior is unintuitive for the user pressing (eg) C-M-f +himself, but since these are single objects I think it's right." + (let ((dir (if (> n 0) 1 -1)) + (forward-sexp-function nil)) ; force the built-in version + (while (not (zerop n)) + (forward-sexp dir) + (when (save-excursion ; move back to see if we're in a record literal + (and + (condition-case nil + (progn (backward-sexp) 't) + ('scan-error nil)) + (looking-at "#\\w"))) + (forward-sexp dir)) ; if so, jump over it + (setq n (- n dir))))) + +(defun clojure-indent-function (indent-point state) + "This function is the normal value of the variable `lisp-indent-function'. +It is used when indenting a line within a function call, to see if the +called function says anything special about how to indent the line. + +INDENT-POINT is the position where the user typed TAB, or equivalent. +Point is located at the point to indent under (for default indentation); +STATE is the `parse-partial-sexp' state for that position. + +If the current line is in a call to a Lisp function +which has a non-nil property `lisp-indent-function', +that specifies how to do the indentation. The property value can be +* `defun', meaning indent `defun'-style; +* an integer N, meaning indent the first N arguments specially + like ordinary function arguments and then indent any further + arguments like a body; +* a function to call just as this function was called. + If that function returns nil, that means it doesn't specify + the indentation. + +This function also returns nil meaning don't specify the 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) + (if (and (eq (char-after (point)) ?\[) + (eq (char-after (elt state 1)) ?\()) + (+ (current-column) 2) ;; this is probably inside a defn + (current-column))) + (let ((function (buffer-substring (point) + (progn (forward-sexp 1) (point)))) + (open-paren (elt state 1)) + method) + (setq method (get (intern-soft function) 'clojure-indent-function)) + + (cond ((member (char-after open-paren) '(?\[ ?\{)) + (goto-char open-paren) + (1+ (current-column))) + ((or (eq method 'defun) + (and (null method) + (> (length function) 3) + (string-match "\\`\\(?:\\S +/\\)?def\\|with-" + function))) + (lisp-indent-defform state indent-point)) + + ((integerp method) + (lisp-indent-specform method state + indent-point normal-indent)) + (method + (funcall method indent-point state)) + (clojure-mode-use-backtracking-indent + (clojure-backtracking-indent + indent-point state normal-indent))))))) + +(defun clojure-backtracking-indent (indent-point state normal-indent) + "Experimental backtracking support. Will upwards in an sexp to +check for contextual indenting." + (let (indent (path) (depth 0)) + (goto-char (elt state 1)) + (while (and (not indent) + (< depth clojure-max-backtracking)) + (let ((containing-sexp (point))) + (parse-partial-sexp (1+ containing-sexp) indent-point 1 t) + (when (looking-at "\\sw\\|\\s_") + (let* ((start (point)) + (fn (buffer-substring start (progn (forward-sexp 1) (point)))) + (meth (get (intern-soft fn) 'clojure-backtracking-indent))) + (let ((n 0)) + (when (< (point) indent-point) + (condition-case () + (progn + (forward-sexp 1) + (while (< (point) indent-point) + (parse-partial-sexp (point) indent-point 1 t) + (incf n) + (forward-sexp 1))) + (error nil))) + (push n path)) + (when meth + (let ((def meth)) + (dolist (p path) + (if (and (listp def) + (< p (length def))) + (setq def (nth p def)) + (if (listp def) + (setq def (car (last def))) + (setq def nil)))) + (goto-char (elt state 1)) + (when def + (setq indent (+ (current-column) def))))))) + (goto-char containing-sexp) + (condition-case () + (progn + (backward-up-list 1) + (incf depth)) + (error (setq depth clojure-max-backtracking))))) + indent)) + +;; clojure backtracking indent is experimental and the format for these +;; entries are subject to change +(put 'implement 'clojure-backtracking-indent '(4 (2))) +(put 'letfn 'clojure-backtracking-indent '((2) 2)) +(put 'proxy 'clojure-backtracking-indent '(4 4 (2))) +(put 'reify 'clojure-backtracking-indent '((2))) +(put 'deftype 'clojure-backtracking-indent '(4 4 (2))) +(put 'defrecord 'clojure-backtracking-indent '(4 4 (2))) +(put 'defprotocol 'clojure-backtracking-indent '(4 (2))) +(put 'extend-type 'clojure-backtracking-indent '(4 (2))) +(put 'extend-protocol 'clojure-backtracking-indent '(4 (2))) + +(defun put-clojure-indent (sym indent) + (put sym 'clojure-indent-function indent)) + +(defmacro define-clojure-indent (&rest kvs) + `(progn + ,@(mapcar (lambda (x) `(put-clojure-indent + (quote ,(first x)) ,(second x))) kvs))) + +(defun add-custom-clojure-indents (name value) + (setq clojure-defun-indents value) + (mapcar (lambda (x) + (put-clojure-indent x 'defun)) + value)) + +(defcustom clojure-defun-indents nil + "List of symbols to give defun-style indentation to in Clojure +code, in addition to those that are built-in. You can use this to +get emacs to indent your own macros the same as it does the +built-ins like with-open. To set manually from lisp code, +use (put-clojure-indent 'some-symbol 'defun)." + :type '(repeat symbol) + :group 'clojure-mode + :set 'add-custom-clojure-indents) + +(define-clojure-indent + ;; built-ins + (ns 1) + (fn 'defun) + (def 'defun) + (defn 'defun) + (bound-fn 'defun) + (if 1) + (if-not 1) + (case 1) + (condp 2) + (when 1) + (while 1) + (when-not 1) + (when-first 1) + (do 0) + (future 0) + (comment 0) + (doto 1) + (locking 1) + (proxy 2) + (with-open 1) + (with-precision 1) + (with-local-vars 1) + + (reify 'defun) + (deftype 2) + (defrecord 2) + (defprotocol 1) + (extend 1) + (extend-protocol 1) + (extend-type 1) + + (try 0) + (catch 2) + (finally 0) + + ;; binding forms + (let 1) + (letfn 1) + (binding 1) + (loop 1) + (for 1) + (doseq 1) + (dotimes 1) + (when-let 1) + (if-let 1) + + ;; data structures + (defstruct 1) + (struct-map 1) + (assoc 1) + + (defmethod 'defun) + + ;; clojure.test + (testing 1) + (deftest 'defun) + + ;; contrib + (handler-case 1) + (handle 1) + (dotrace 1) + (deftrace 'defun)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Better docstring filling for clojure-mode +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun clojure-string-start () + "Return the position of the \" that begins the string at point." + (save-excursion + (save-match-data + ;; Find a quote that appears immediately after whitespace, + ;; beginning of line, or an open paren, brace, or bracket + (re-search-backward "\\(\\s-\\|^\\|(\\|\\[\\|{\\)\\(\"\\)") + (match-beginning 2)))) + +(defun clojure-char-at-point () + "Return the char at point or nil if at buffer end." + (when (not (= (point) (point-max))) + (buffer-substring-no-properties (point) (1+ (point))))) + +(defun clojure-char-before-point () + "Return the char before point or nil if at buffer beginning." + (when (not (= (point) (point-min))) + (buffer-substring-no-properties (point) (1- (point))))) + +;; TODO: Deal with the fact that when point is exactly at the +;; beginning of a string, it thinks that is the end. +(defun clojure-string-end () + "Return the position of the \" that ends the string at point. + +Note that point must be inside the string - if point is +positioned at the opening quote, incorrect results will be +returned." + (save-excursion + (save-match-data + ;; If we're at the end of the string, just return point. + (if (and (string= (clojure-char-at-point) "\"") + (not (string= (clojure-char-before-point) "\\"))) + (point) + ;; We don't want to get screwed by starting out at the + ;; backslash in an escaped quote. + (when (string= (clojure-char-at-point) "\\") + (backward-char)) + ;; Look for a quote not preceeded by a backslash + (re-search-forward "[^\\]\\\(\\\"\\)") + (match-beginning 1))))) + +(defun clojure-docstring-start+end-points () + "Return the start and end points of the string at point as a cons." + (if (and (fboundp 'paredit-string-start+end-points) paredit-mode) + (paredit-string-start+end-points) + (cons (clojure-string-start) (clojure-string-end)))) + +(defun clojure-mark-string () + "Mark the string at point." + (interactive) + (goto-char (clojure-string-start)) + (forward-char) + (set-mark (clojure-string-end))) + +(defun clojure-fill-docstring (&optional argument) + "Fill the definition that the point is on appropriate for Clojure. + + Fills so that every paragraph has a minimum of two initial spaces, + with the exception of the first line. Fill margins are taken from + paragraph start, so a paragraph that begins with four spaces will + remain indented by four spaces after refilling." + (interactive "P") + (if (and (fboundp 'paredit-in-string-p) paredit-mode) + (unless (paredit-in-string-p) + (error "Must be inside a string"))) + ;; Oddly, save-excursion doesn't do a good job of preserving point. + ;; It's probably because we delete the string and then re-insert it. + (let ((old-point (point))) + (save-restriction + (save-excursion + (let* ((string-region (clojure-docstring-start+end-points)) + (string-start (1+ (car string-region))) + (string-end (cdr string-region)) + (string (buffer-substring-no-properties (1+ (car string-region)) + (cdr string-region)))) + (delete-region string-start string-end) + (insert + (with-temp-buffer + (insert string) + (let ((left-margin 2)) + (delete-trailing-whitespace) + (fill-region (point-min) (point-max)) + (buffer-substring-no-properties (+ 2 (point-min)) (point-max)))))))) + (goto-char old-point))) + + + +(defconst clojure-namespace-name-regex + (rx line-start + "(" + (zero-or-one (group (regexp "clojure.core/"))) + (zero-or-one (submatch "in-")) + "ns" + (zero-or-one "+") + (one-or-more (any whitespace "\n")) + (zero-or-more (or (submatch (zero-or-one "#") + "^{" + (zero-or-more (not (any "}"))) + "}") + (zero-or-more "^:" + (one-or-more (not (any whitespace))))) + (one-or-more (any whitespace "\n"))) + ;; why is this here? oh (in-ns 'foo) or (ns+ :user) + (zero-or-one (any ":'")) + (group (one-or-more (not (any "()\"" whitespace))) word-end))) + +;; for testing clojure-namespace-name-regex, you can evaluate this code and make +;; sure foo (or whatever the namespace name is) shows up in results. some of +;; these currently fail. +;; (mapcar (lambda (s) (let ((n (string-match clojure-namespace-name-regex s))) +;; (if n (match-string 4 s)))) +;; '("(ns foo)" +;; "(ns +;; foo)" +;; "(ns foo.baz)" +;; "(ns ^:bar foo)" +;; "(ns ^:bar ^:baz foo)" +;; "(ns ^{:bar true} foo)" +;; "(ns #^{:bar true} foo)" +;; "(ns #^{:fail {}} foo)" +;; "(ns ^{:fail2 {}} foo.baz)" +;; "(ns ^{} foo)" +;; "(ns ^{:skip-wiki true} +;; aleph.netty +;; " +;; "(ns +;; foo)" +;; "foo")) + + + +(defun clojure-insert-ns-form () + (interactive) + (goto-char (point-min)) + (let* ((rel (car (last (split-string buffer-file-name "src/\\|test/")))) + (relative (car (split-string rel "\\.clj"))) + (segments (split-string relative "/"))) + (insert (format "(ns %s)" (mapconcat #'identity segments "."))))) + + +;;; Slime help + +(defvar clojure-project-root-file "project.clj") + +;; Pipe to $SHELL to work around mackosecks GUI Emacs $PATH issues. +(defcustom clojure-swank-command + (if (or (locate-file "lein" exec-path) (locate-file "lein.bat" exec-path)) + "lein jack-in %s" + "echo \"lein jack-in %s\" | $SHELL -l") + "The command used to start swank via clojure-jack-in. +For remote swank it is lein must be in your PATH and the remote +proc is launched via sh rather than bash, so it might be necessary +to specific the full path to it. The argument is the port to connect on. +Localhost is assumed." + :type 'string + :group 'clojure-mode) + +(defcustom clojure-generate-remote-swank-command-function + 'clojure-generate-remote-swank-command-ssh-tunnel + "A function that is called to determine the swank command that +`clojure-jack-in` will execute and the hostname/port that slime +should connect to for remote projects that are opened via tramp. + +The arguments are dir, hostname, and port. The return value should be an `alist` of the form +(:cmd \"command string\" :hostname \"hostname\" :port 1234)" + :type 'function + :group 'clojure-mode) + +(defun clojure-generate-local-swank-command-default (dir hostname port) + (if (not (string-equal "localhost" hostname)) + (error (concat + "If you need to jack-in to remote projects/jvms over tramp, " + "you need to define a custom `clojure-generate-swank-command-function`")) + (list :cmd (format clojure-swank-command port) + :hostname hostname + :port port))) + +(defun clojure-generate-remote-swank-command-ssh-tunnel (dir hostname port) + (destructuring-bind (_method user host localname) + (append (tramp-dissect-file-name dir) nil) + (list :cmd (format-spec + "ssh -L %p:localhost:%p -l '%u' '%h' 'cd \'%d\'; lein jack-in \'%p\''" + `((?p . ,port) + (?h . ,host) + (?u . ,(or user (getenv "USER"))) + (?d . ,localname))) + :hostname "localhost" + :port port))) + +(defun clojure-generate-swank-cmd (dir hostname port) + (if (file-remote-p dir) + (if (functionp clojure-generate-remote-swank-command-function) + (funcall clojure-generate-remote-swank-command-function dir hostname port) + (error (concat + "If you need to jack-in to remote projects/jvms over tramp " + "you need to define a custom `clojure-generate-remote-swank-command-function`"))) + (clojure-generate-local-swank-command-default dir hostname port))) + +(defun clojure-jack-in-sentinel (process event) + (let ((debug-on-error t)) + (error "Could not start swank server: %s" + (let ((b (process-buffer process))) + (if (and b (buffer-live-p b)) + (with-current-buffer b + (buffer-substring (point-min) (point-max)))))))) + +(defun clojure-eval-bootstrap-region (process) + "Eval only the elisp in between the markers." + (with-current-buffer (process-buffer process) + (save-excursion + (goto-char 0) + (search-forward ";;; Bootstrapping bundled version of SLIME") + (let ((begin (point))) + (when (not (search-forward ";;; Done bootstrapping." nil t)) + ;; fall back to possibly-ambiguous string if above isn't found + (search-forward "(run-hooks 'slime-load-hook)")) + (eval-region begin (point)))))) + +(defun clojure-kill-swank-buffer (swank-buffer-name) + (when (get-buffer swank-buffer-name) + (let ((process (get-buffer-process (get-buffer swank-buffer-name)))) + (if process + (set-process-query-on-exit-flag process nil)) + (kill-buffer swank-buffer-name)))) + +(defun clojure-generate-swank-connection-name (dir hostname) + "swank") + +(defun clojure-jack-in-start-process (swank-connection-name swank-buffer-name dir hostname) + ;; The buffer has to be created before the proc if + ;; `start-file-process-shell-command` is used. It doesn't hurt to do + ;; it now even if `start-process-shell-command` is used: + (get-buffer-create swank-buffer-name) + + (let ((port (- 65535 (mod (caddr (current-time)) 4096)))) + (destructuring-bind (&key cmd hostname port) + (clojure-generate-swank-cmd dir hostname port) + (lexical-let* ((proc (start-process-shell-command + ;; this command runs locally + ;; `start-file-process-shell-command` would + ;; run remote for tramp buffers + swank-connection-name + swank-buffer-name + cmd)) + (dir dir) + (hostname hostname) + (port port) + (connect-callback (lambda () (slime-connect hostname port)))) + (set-process-sentinel proc 'clojure-jack-in-sentinel) + (set-process-query-on-exit-flag proc nil) + (set-process-filter proc + (lambda (process output) + (with-current-buffer (process-buffer process) + (insert output)) + (when (string-match "proceed to jack in" output) + (clojure-eval-bootstrap-region process) + (with-current-buffer + ;; this block is an attempt to avoid + ;; creating duplicate repl windows + (or + (get-buffer "*slime-repl clojure*") + (get-buffer "*slime-repl nil*") + (current-buffer)) + (funcall connect-callback) + (when (string-match "slime-repl" (buffer-name)) + ;; this is most likely an old repl + ;; buffer that existed prior to the + ;; jack-in call. + (setq default-directory dir) + (goto-char (point-max)))) + (set-process-sentinel process nil) + (set-process-filter process nil)))))))) + +;;;###autoload +(defun clojure-jack-in () + (interactive) + (setq slime-net-coding-system 'utf-8-unix) + (let* ((dir default-directory) + (hostname (if (file-remote-p default-directory) + tramp-current-host "localhost")) + (connection-name (clojure-generate-swank-connection-name dir hostname)) + (swank-buffer-name (format "*%s*" connection-name))) + + (when (and (functionp 'slime-disconnect) + (slime-current-connection) + ;; TODO: ask for permission once jack-in supports multiple connections + ;; (and (interactive-p) (y-or-n-p "Close old connections first? ")) + ) + (slime-disconnect)) + (clojure-kill-swank-buffer swank-buffer-name) + (clojure-jack-in-start-process connection-name swank-buffer-name dir hostname)) + (message "Starting swank server...")) + +(defun clojure-find-ns () + (let ((regexp clojure-namespace-name-regex)) + (save-excursion + (when (or (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (match-string-no-properties 4))))) + +(defalias 'clojure-find-package 'clojure-find-ns) + +(defun clojure-enable-slime () + (slime-mode t) + (set (make-local-variable 'slime-find-buffer-package-function) + 'clojure-find-ns)) + +;;;###autoload +(defun clojure-enable-slime-on-existing-buffers () + (interactive) + (add-hook 'clojure-mode-hook 'clojure-enable-slime) + (save-window-excursion + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'clojure-mode) + (clojure-enable-slime)))))) + +;; Test navigation: +(defun clojure-in-tests-p () + (or (string-match-p "test\." (clojure-find-ns)) + (string-match-p "/test" (buffer-file-name)))) + +(defun clojure-underscores-for-hyphens (namespace) + (replace-regexp-in-string "-" "_" namespace)) + +(defun clojure-test-for (namespace) + (let* ((namespace (clojure-underscores-for-hyphens namespace)) + (segments (split-string namespace "\\.")) + (before (subseq segments 0 clojure-test-ns-segment-position)) + (after (subseq segments clojure-test-ns-segment-position)) + (test-segments (append before (list "test") after))) + (mapconcat 'identity test-segments "/"))) + +(defun clojure-jump-to-test () + "Jump from implementation file to test." + (interactive) + (find-file (format "%stest/%s.clj" + (file-name-as-directory + (locate-dominating-file buffer-file-name "src/")) + (clojure-test-for (clojure-find-ns))))) + +(defun clojure-jump-between-tests-and-code () + (interactive) + (if (clojure-in-tests-p) + (clojure-test-jump-to-implementation) + (clojure-jump-to-test))) + +;;; slime filename translation for tramp +(defun clojure-slime-tramp-local-filename (f) + (if (file-remote-p f) + (tramp-file-name-localname + (tramp-dissect-file-name f)) + f)) + +(defun clojure-slime-tramp-remote-filename (f) + (if (file-remote-p default-directory) + (tramp-make-tramp-file-name + (tramp-file-name-method + (tramp-dissect-file-name default-directory)) + (tramp-file-name-user + (tramp-dissect-file-name default-directory)) + (tramp-file-name-host + (tramp-dissect-file-name default-directory)) + f) + f)) + +(defun clojure-slime-remote-file-name-hook () + (setq slime-from-lisp-filename-function + 'clojure-slime-tramp-remote-filename) + (setq slime-to-lisp-filename-function + 'clojure-slime-tramp-local-filename)) + +(add-hook 'slime-connected-hook 'clojure-slime-remote-file-name-hook) + +;;;###autoload +(add-hook 'slime-connected-hook 'clojure-enable-slime-on-existing-buffers) + +(add-hook 'slime-indentation-update-hooks 'put-clojure-indent) + + + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.clj$" . clojure-mode)) +(add-to-list 'interpreter-mode-alist '("jark" . clojure-mode)) +(add-to-list 'interpreter-mode-alist '("cake" . clojure-mode)) + +(provide 'clojure-mode) +;;; clojure-mode.el ends here