View | Details | Raw Unified | Return to bug 221818 | Differences between
and this patch

Collapse All | Expand All

(-)clojure-mode-5.6.1/clojure-mode.el (-891 / +2148 lines)
Lines 1-31 Link Here
1
;;; clojure-mode.el --- Major mode for Clojure code
1
;;; clojure-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*-
2
2
3
;; Copyright © 2007-2013 Jeffrey Chu, Lennart Staflin, Phil Hagelberg
3
;; Copyright © 2007-2017 Jeffrey Chu, Lennart Staflin, Phil Hagelberg
4
;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba
4
;;
5
;;
5
;; Authors: Jeffrey Chu <jochu0@gmail.com>
6
;; Authors: Jeffrey Chu <jochu0@gmail.com>
6
;;          Lennart Staflin <lenst@lysator.liu.se>
7
;;       Lennart Staflin <lenst@lysator.liu.se>
7
;;          Phil Hagelberg <technomancy@gmail.com>
8
;;       Phil Hagelberg <technomancy@gmail.com>
9
;;       Bozhidar Batsov <bozhidar@batsov.com>
10
;;       Artur Malabarba <bruce.connor.am@gmail.com>
8
;; URL: http://github.com/clojure-emacs/clojure-mode
11
;; URL: http://github.com/clojure-emacs/clojure-mode
9
;; Version: 2.1.1
12
;; Keywords: languages clojure clojurescript lisp
10
;; Keywords: languages, lisp
13
;; Version: 5.7.0-snapshot
14
;; Package-Requires: ((emacs "24.4"))
11
15
12
;; This file is not part of GNU Emacs.
16
;; This file is not part of GNU Emacs.
13
17
14
;;; Commentary:
18
;;; Commentary:
15
19
16
;; Provides font-lock, indentation, and navigation for the Clojure
20
;; Provides font-lock, indentation, navigation and basic refactoring for the
17
;; programming language (http://clojure.org).
21
;; Clojure programming language (http://clojure.org).
18
22
19
;; Users of older Emacs (pre-22) should get version 1.4:
23
;; Using clojure-mode with paredit or smartparens is highly recommended.
20
;; http://github.com/clojure-emacs/clojure-mode/tree/1.4
21
24
22
;; Slime integration has been removed; see the 1.x releases if you need it.
25
;; Here are some example configurations:
23
26
24
;; Using clojure-mode with paredit is highly recommended.  Use paredit
25
;; as you would with any other minor mode; for instance:
26
;;
27
;;   ;; require or autoload paredit-mode
27
;;   ;; require or autoload paredit-mode
28
;;   (add-hook 'clojure-mode-hook 'paredit-mode)
28
;;   (add-hook 'clojure-mode-hook #'paredit-mode)
29
30
;;   ;; require or autoload smartparens
31
;;   (add-hook 'clojure-mode-hook #'smartparens-strict-mode)
32
33
;; See inf-clojure (http://github.com/clojure-emacs/inf-clojure) for
34
;; basic interaction with Clojure subprocesses.
29
35
30
;; See CIDER (http://github.com/clojure-emacs/cider) for
36
;; See CIDER (http://github.com/clojure-emacs/cider) for
31
;; better interaction with subprocesses via nREPL.
37
;; better interaction with subprocesses via nREPL.
Lines 50-63 Link Here
50
;;; Code:
56
;;; Code:
51
57
52
58
53
;;; Compatibility
54
(eval-and-compile
55
  ;; `setq-local' for Emacs 24.2 and below
56
  (unless (fboundp 'setq-local)
57
    (defmacro setq-local (var val)
58
      "Set variable VAR to value VAL in current buffer."
59
      `(set (make-local-variable ',var) ,val))))
60
61
(eval-when-compile
59
(eval-when-compile
62
  (defvar calculate-lisp-indent-last-sexp)
60
  (defvar calculate-lisp-indent-last-sexp)
63
  (defvar font-lock-beg)
61
  (defvar font-lock-beg)
Lines 66-465 Link Here
66
  (defvar paredit-version)
64
  (defvar paredit-version)
67
  (defvar paredit-mode))
65
  (defvar paredit-mode))
68
66
69
(require 'cl)
67
(require 'cl-lib)
70
(require 'tramp)
71
(require 'inf-lisp)
72
(require 'imenu)
68
(require 'imenu)
73
(require 'easymenu)
69
(require 'newcomment)
74
70
(require 'align)
75
(declare-function clojure-test-jump-to-implementation  "clojure-test-mode.el")
71
(require 'subr-x)
76
72
77
(defconst clojure-font-lock-keywords
73
(declare-function lisp-fill-paragraph  "lisp-mode" (&optional justify))
78
  (eval-when-compile
79
    `( ;; Definitions.
80
      (,(concat "(\\(?:clojure.core/\\)?\\("
81
                (regexp-opt '("defn" "defn-" "def" "defonce"
82
                              "defmulti" "defmethod" "defmacro"
83
                              "defstruct" "deftype" "defprotocol"
84
                              "defrecord" "deftest" "def\\[a-z\\]"))
85
                ;; Function declarations.
86
                "\\)\\>"
87
                ;; Any whitespace
88
                "[ \r\n\t]*"
89
                ;; Possibly type or metadata
90
                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
91
                "\\(\\sw+\\)?")
92
       (1 font-lock-keyword-face)
93
       (2 font-lock-function-name-face nil t))
94
      ;; (fn name? args ...)
95
      (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+"
96
                ;; Possibly type
97
                "\\(?:#?^\\sw+[ \t]*\\)?"
98
                ;; Possibly name
99
                "\\(t\\sw+\\)?" )
100
       (1 font-lock-keyword-face)
101
       (2 font-lock-function-name-face nil t))
102
103
      (,(concat "(\\(\\(?:[a-z\.-]+/\\)?def\[a-z\-\]*-?\\)"
104
                ;; Function declarations.
105
                "\\>"
106
                ;; Any whitespace
107
                "[ \r\n\t]*"
108
                ;; Possibly type or metadata
109
                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
110
                "\\(\\sw+\\)?")
111
       (1 font-lock-keyword-face)
112
       (2 font-lock-function-name-face nil t))
113
      ;; Deprecated functions
114
      (,(concat
115
         "(\\(?:clojure.core/\\)?"
116
         (regexp-opt
117
          '("add-watcher" "remove-watcher" "add-classpath") t)
118
         "\\>")
119
       1 font-lock-warning-face)
120
      ;; Control structures
121
      (,(concat
122
         "(\\(?:clojure.core/\\)?"
123
         (regexp-opt
124
          '("let" "letfn" "do"
125
            "case" "cond" "condp"
126
            "for" "loop" "recur"
127
            "when" "when-not" "when-let" "when-first"
128
            "if" "if-let" "if-not"
129
            "." ".." "->" "->>" "doto"
130
            "and" "or"
131
            "dosync" "doseq" "dotimes" "dorun" "doall"
132
            "load" "import" "unimport" "ns" "in-ns" "refer"
133
            "try" "catch" "finally" "throw"
134
            "with-open" "with-local-vars" "binding"
135
            "gen-class" "gen-and-load-class" "gen-and-save-class"
136
            "handler-case" "handle") t)
137
         "\\>")
138
       1 font-lock-keyword-face)
139
      ;; Built-ins
140
      (,(concat
141
         "(\\(?:clojure.core/\\)?"
142
         (regexp-opt
143
          '("*" "*1" "*2" "*3" "*agent*"
144
        "*allow-unresolved-vars*" "*assert*" "*clojure-version*" "*command-line-args*" "*compile-files*"
145
        "*compile-path*" "*e" "*err*" "*file*" "*flush-on-newline*"
146
        "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*"
147
        "*print-dup*" "*print-length*" "*print-level*" "*print-meta*" "*print-readably*"
148
        "*read-eval*" "*source-path*" "*use-context-classloader*" "*warn-on-reflection*" "+"
149
        "-" "/"
150
        "<" "<=" "=" "==" ">"
151
        ">=" "accessor" "aclone"
152
        "agent" "agent-errors" "aget" "alength" "alias"
153
        "all-ns" "alter" "alter-meta!" "alter-var-root" "amap"
154
        "ancestors" "and" "apply" "areduce" "array-map" "as->"
155
        "aset" "aset-boolean" "aset-byte" "aset-char" "aset-double"
156
        "aset-float" "aset-int" "aset-long" "aset-short" "assert"
157
        "assoc" "assoc!" "assoc-in" "associative?" "atom"
158
        "await" "await-for" "await1" "bases" "bean"
159
        "bigdec" "bigint" "binding" "bit-and" "bit-and-not"
160
        "bit-clear" "bit-flip" "bit-not" "bit-or" "bit-set"
161
        "bit-shift-left" "bit-shift-right" "bit-test" "bit-xor" "boolean"
162
        "boolean-array" "booleans" "bound-fn" "bound-fn*" "butlast"
163
        "byte" "byte-array" "bytes" "case" "cast" "char"
164
        "char-array" "char-escape-string" "char-name-string" "char?" "chars"
165
        "chunk" "chunk-append" "chunk-buffer" "chunk-cons" "chunk-first"
166
        "chunk-next" "chunk-rest" "chunked-seq?" "class" "class?"
167
        "clear-agent-errors" "clojure-version" "coll?" "comment" "commute"
168
        "comp" "comparator" "compare" "compare-and-set!" "compile"
169
        "complement" "concat" "cond" "condp" "cond->" "cond->>" "conj"
170
        "conj!" "cons" "constantly" "construct-proxy" "contains?"
171
        "count" "counted?" "create-ns" "create-struct" "cycle"
172
        "dec" "decimal?" "declare" "definline" "defmacro"
173
        "defmethod" "defmulti" "defn" "defn-" "defonce"
174
        "defstruct" "delay" "delay?" "deliver" "deref"
175
        "derive" "descendants" "destructure" "disj" "disj!"
176
        "dissoc" "dissoc!" "distinct" "distinct?" "doall"
177
        "doc" "dorun" "doseq" "dosync" "dotimes"
178
        "doto" "double" "double-array" "doubles" "drop"
179
        "drop-last" "drop-while" "empty" "empty?" "ensure"
180
        "enumeration-seq" "eval" "even?" "every?"
181
        "extend" "extend-protocol" "extend-type" "extends?" "extenders" "ex-info" "ex-data"
182
        "false?" "ffirst" "file-seq" "filter" "filterv" "find" "find-doc"
183
        "find-ns" "find-var" "first" "flatten" "float" "float-array"
184
        "float?" "floats" "flush" "fn" "fn?"
185
        "fnext" "for" "force" "format" "future"
186
        "future-call" "future-cancel" "future-cancelled?" "future-done?" "future?"
187
        "gen-class" "gen-interface" "gensym" "get" "get-in"
188
        "get-method" "get-proxy-class" "get-thread-bindings" "get-validator" "group-by"
189
        "hash" "hash-map" "hash-set" "identical?" "identity" "if-let"
190
        "if-not" "ifn?" "import" "in-ns" "inc"
191
        "init-proxy" "instance?" "int" "int-array" "integer?"
192
        "interleave" "intern" "interpose" "into" "into-array"
193
        "ints" "io!" "isa?" "iterate" "iterator-seq"
194
        "juxt" "key" "keys" "keyword" "keyword?"
195
        "last" "lazy-cat" "lazy-seq" "let" "letfn"
196
        "line-seq" "list" "list*" "list?" "load"
197
        "load-file" "load-reader" "load-string" "loaded-libs" "locking"
198
        "long" "long-array" "longs" "loop" "macroexpand"
199
        "macroexpand-1" "make-array" "make-hierarchy" "map" "mapv" "map?"
200
        "map-indexed" "mapcat" "max" "max-key" "memfn" "memoize"
201
        "merge" "merge-with" "meta" "method-sig" "methods"
202
        "min" "min-key" "mod" "name" "namespace"
203
        "neg?" "newline" "next" "nfirst" "nil?"
204
        "nnext" "not" "not-any?" "not-empty" "not-every?"
205
        "not=" "ns" "ns-aliases" "ns-imports" "ns-interns"
206
        "ns-map" "ns-name" "ns-publics" "ns-refers" "ns-resolve"
207
        "ns-unalias" "ns-unmap" "nth" "nthnext" "num"
208
        "number?" "odd?" "or" "parents" "partial"
209
        "partition" "partition-all" "partition-by" "pcalls" "peek" "persistent!" "pmap"
210
        "pop" "pop!" "pop-thread-bindings" "pos?" "pr"
211
        "pr-str" "prefer-method" "prefers" "primitives-classnames" "print"
212
        "print-ctor" "print-doc" "print-dup" "print-method" "print-namespace-doc"
213
        "print-simple" "print-special-doc" "print-str" "printf" "println"
214
        "println-str" "prn" "prn-str" "promise" "proxy"
215
        "proxy-call-with-super" "proxy-mappings" "proxy-name" "proxy-super" "push-thread-bindings"
216
        "pvalues" "quot" "rand" "rand-int" "range"
217
        "ratio?" "rational?" "rationalize" "re-find" "re-groups"
218
        "re-matcher" "re-matches" "re-pattern" "re-seq" "read"
219
        "read-line" "read-string" "reify" "reduce" "reduce-kv" "ref" "ref-history-count"
220
        "ref-max-history" "ref-min-history" "ref-set" "refer" "refer-clojure"
221
        "release-pending-sends" "rem" "remove" "remove-method" "remove-ns"
222
        "repeat" "repeatedly" "replace" "replicate"
223
        "require" "reset!" "reset-meta!" "resolve" "rest"
224
        "resultset-seq" "reverse" "reversible?" "rseq" "rsubseq"
225
        "satisfies?" "second" "select-keys" "send" "send-off" "send-via" "seq"
226
        "seq?" "seque" "sequence" "sequential?" "set"
227
        "set-agent-send-executor!" "set-agent-send-off-executor!"
228
        "set-validator!" "set?" "short" "short-array" "shorts"
229
        "shutdown-agents" "slurp" "some" "some->" "some->>" "sort" "sort-by"
230
        "sorted-map" "sorted-map-by" "sorted-set" "sorted-set-by" "sorted?"
231
        "special-form-anchor" "special-symbol?" "spit" "split-at" "split-with" "str"
232
        "stream?" "string?" "struct" "struct-map" "subs"
233
        "subseq" "subvec" "supers" "swap!" "symbol"
234
        "symbol?" "sync" "syntax-symbol-anchor" "take" "take-last"
235
        "take-nth" "take-while" "test" "the-ns" "time"
236
        "to-array" "to-array-2d" "trampoline" "transient" "tree-seq"
237
        "true?" "type" "unchecked-add" "unchecked-dec" "unchecked-divide"
238
        "unchecked-inc" "unchecked-multiply" "unchecked-negate" "unchecked-remainder" "unchecked-subtract"
239
        "underive" "unquote" "unquote-splicing" "update-in" "update-proxy"
240
        "use" "val" "vals" "var-get" "var-set"
241
        "var?" "vary-meta" "vec" "vector" "vector?"
242
        "when" "when-first" "when-let" "when-not" "while"
243
        "with-bindings" "with-bindings*" "with-in-str" "with-loading-context" "with-local-vars"
244
        "with-meta" "with-open" "with-out-str" "with-precision"
245
        "with-redefs" "with-redefs-fn" "xml-seq" "zero?" "zipmap"
246
        ) t)
247
         "\\>")
248
       1 font-lock-builtin-face)
249
      ;;Other namespaces in clojure.jar
250
      (,(concat
251
         "(\\(?:\.*/\\)?"
252
         (regexp-opt
253
          '(;; clojure.inspector
254
        "atom?" "collection-tag" "get-child" "get-child-count" "inspect"
255
        "inspect-table" "inspect-tree" "is-leaf" "list-model" "list-provider"
256
        ;; clojure.main
257
        "load-script" "main" "repl" "repl-caught" "repl-exception"
258
        "repl-prompt" "repl-read" "skip-if-eol" "skip-whitespace" "with-bindings"
259
        ;; clojure.set
260
        "difference" "index" "intersection" "join" "map-invert"
261
        "project" "rename" "rename-keys" "select" "union"
262
        ;; clojure.stacktrace
263
        "e" "print-cause-trace" "print-stack-trace" "print-throwable" "print-trace-element"
264
        ;; clojure.template
265
        "do-template" "apply-template"
266
        ;; clojure.test
267
        "*initial-report-counters*" "*load-tests*" "*report-counters*" "*stack-trace-depth*" "*test-out*"
268
        "*testing-contexts*" "*testing-vars*" "are" "assert-any" "assert-expr"
269
        "assert-predicate" "compose-fixtures" "deftest" "deftest-" "file-position"
270
        "function?" "get-possibly-unbound-var" "inc-report-counter" "is" "join-fixtures"
271
        "report" "run-all-tests" "run-tests" "set-test" "successful?"
272
        "test-all-vars" "test-ns" "test-var" "testing" "testing-contexts-str"
273
        "testing-vars-str" "try-expr" "use-fixtures" "with-test" "with-test-out"
274
        ;; clojure.walk
275
        "keywordize-keys" "macroexpand-all" "postwalk" "postwalk-demo" "postwalk-replace"
276
        "prewalk" "prewalk-demo" "prewalk-replace" "stringify-keys" "walk"
277
        ;; clojure.xml
278
        "*current*" "*sb*" "*stack*" "*state*" "attrs"
279
        "content" "content-handler" "element" "emit" "emit-element"
280
        ;; clojure.zip
281
        "append-child" "branch?" "children" "down" "edit"
282
        "end?" "insert-child" "insert-left" "insert-right" "left"
283
        "leftmost" "lefts" "make-node" "next" "node"
284
        "path" "prev" "remove" "replace" "right"
285
        "rightmost" "rights" "root" "seq-zip" "up"
286
        ) t)
287
         "\\>")
288
       1 font-lock-builtin-face)
289
      ;; Constant values (keywords), including as metadata e.g. ^:static
290
      ("\\<^?:\\(\\sw\\|\\s_\\)+\\(\\>\\|\\_>\\)" 0 font-lock-constant-face)
291
      ;; Meta type hint #^Type or ^Type
292
      ("\\(#?^\\)\\(\\(\\sw\\|\\s_\\)+\\)"
293
       (1 font-lock-preprocessor-face)
294
       (2 font-lock-type-face))
295
296
      ;;Java interop highlighting
297
      ("\\<\\.-?[a-z][a-zA-Z0-9]*\\>" 0 font-lock-preprocessor-face) ;; .foo .barBaz .qux01 .-flibble .-flibbleWobble
298
      ("\\<[A-Z][a-zA-Z0-9_]*[a-zA-Z0-9/$_]+\\>" 0 font-lock-preprocessor-face) ;; Foo Bar$Baz Qux_ World_OpenUDP
299
      ("\\<[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
300
      ("[a-z]*[A-Z]+[a-z][a-zA-Z0-9$]*\\>" 0 font-lock-preprocessor-face) ;; fooBar
301
      ("\\<[A-Z][a-zA-Z0-9$]*\\.\\>" 0 font-lock-type-face) ;; Foo. BarBaz. Qux$Quux. Corge9.
302
      ;; Highlight grouping constructs in regular expressions
303
      (clojure-mode-font-lock-regexp-groups
304
       (1 'font-lock-regexp-grouping-construct prepend))))
305
  "Default expressions to highlight in Clojure mode.")
306
74
307
(defgroup clojure nil
75
(defgroup clojure nil
308
  "A mode for Clojure"
76
  "Major mode for editing Clojure code."
309
  :prefix "clojure-"
77
  :prefix "clojure-"
310
  :group 'languages
78
  :group 'languages
311
  :link '(url-link :tag "Github" "https://github.com/clojure-emacs/clojure-mode")
79
  :link '(url-link :tag "Github" "https://github.com/clojure-emacs/clojure-mode")
312
  :link '(emacs-commentary-link :tag "Commentary" "clojure-mode"))
80
  :link '(emacs-commentary-link :tag "Commentary" "clojure-mode"))
313
81
314
(defcustom clojure-font-lock-comment-sexp nil
82
(defconst clojure-mode-version "5.7.0-snapshot"
315
  "Set to non-nil in order to enable font-lock of (comment...)
83
  "The current version of `clojure-mode'.")
316
forms.  This option is experimental.  Changing this will require a
317
restart (ie. M-x clojure-mode) of existing clojure mode buffers."
318
  :type 'boolean
319
  :group 'clojure
320
  :safe 'booleanp)
321
322
(defcustom clojure-load-command  "(clojure.core/load-file \"%s\")\n"
323
  "*Format-string for building a Clojure expression to load a file.
324
This format string should use `%s' to substitute a file name
325
and should result in a Clojure expression that will command the inferior
326
Clojure to load that file."
327
  :type 'string
328
  :group 'clojure
329
  :safe 'stringp)
330
84
331
(defcustom clojure-inf-lisp-command "lein repl"
85
(defface clojure-keyword-face
332
  "The command used by `inferior-lisp-program'."
86
  '((t (:inherit font-lock-constant-face)))
333
  :type 'string
87
  "Face used to font-lock Clojure keywords (:something)."
334
  :group 'clojure
88
  :package-version '(clojure-mode . "3.0.0"))
335
  :safe 'stringp)
89
90
(defface clojure-character-face
91
  '((t (:inherit font-lock-string-face)))
92
  "Face used to font-lock Clojure character literals."
93
  :package-version '(clojure-mode . "3.0.0"))
94
95
(defface clojure-interop-method-face
96
  '((t (:inherit font-lock-preprocessor-face)))
97
  "Face used to font-lock interop method names (camelCase)."
98
  :package-version '(clojure-mode . "3.0.0"))
99
100
(defcustom clojure-indent-style :always-align
101
  "Indentation style to use for function forms and macro forms.
102
There are two cases of interest configured by this variable.
103
104
- Case (A) is when at least one function argument is on the same
105
  line as the function name.
106
- Case (B) is the opposite (no arguments are on the same line as
107
  the function name).  Note that the body of macros is not
108
  affected by this variable, it is always indented by
109
  `lisp-body-indent' (default 2) spaces.
110
111
Note that this variable configures the indentation of function
112
forms (and function-like macros), it does not affect macros that
113
already use special indentation rules.
114
115
The possible values for this variable are keywords indicating how
116
to indent function forms.
117
118
    `:always-align' - Follow the same rules as `lisp-mode'.  All
119
    args are vertically aligned with the first arg in case (A),
120
    and vertically aligned with the function name in case (B).
121
    For instance:
122
        (reduce merge
123
                some-coll)
124
        (reduce
125
         merge
126
         some-coll)
127
128
    `:always-indent' - All args are indented like a macro body.
129
        (reduce merge
130
          some-coll)
131
        (reduce
132
          merge
133
          some-coll)
134
135
    `:align-arguments' - Case (A) is indented like `lisp', and
136
    case (B) is indented like a macro body.
137
        (reduce merge
138
                some-coll)
139
        (reduce
140
          merge
141
          some-coll)"
142
  :safe #'keywordp
143
  :type '(choice (const :tag "Same as `lisp-mode'" :always-align)
144
                 (const :tag "Indent like a macro body" :always-indent)
145
                 (const :tag "Indent like a macro body unless first arg is on the same line"
146
                        :align-arguments))
147
  :package-version '(clojure-mode . "5.2.0"))
336
148
337
(defcustom clojure-defun-style-default-indent nil
149
(define-obsolete-variable-alias 'clojure-defun-style-default-indent
338
  "Default indenting of function and macro forms using defun rules unless
150
  'clojure-indent-style "5.2.0")
339
otherwise defined via `put-clojure-indent`, `define-clojure-indent`, etc."
340
  :type 'boolean
341
  :group 'clojure
342
  :safe 'booleanp)
343
151
344
(defcustom clojure-use-backtracking-indent t
152
(defcustom clojure-use-backtracking-indent t
345
  "Set to non-nil to enable backtracking/context sensitive indentation."
153
  "When non-nil, enable context sensitive indentation."
346
  :type 'boolean
154
  :type 'boolean
347
  :group 'clojure
348
  :safe 'booleanp)
155
  :safe 'booleanp)
349
156
350
(defcustom clojure-max-backtracking 3
157
(defcustom clojure-max-backtracking 3
351
  "Maximum amount to backtrack up a list to check for context."
158
  "Maximum amount to backtrack up a list to check for context."
352
  :type 'integer
159
  :type 'integer
353
  :group 'clojure
354
  :safe 'integerp)
160
  :safe 'integerp)
355
161
356
(defcustom clojure-omit-space-between-tag-and-delimiters (list ?\[ ?\{)
162
(defcustom clojure-docstring-fill-column fill-column
357
  "List of opening delimiter characters allowed to appear
163
  "Value of `fill-column' to use when filling a docstring."
358
immediately after a reader literal tag with no space, as
164
  :type 'integer
359
in :db/id[:db.part/user]"
165
  :safe 'integerp)
166
167
(defcustom clojure-docstring-fill-prefix-width 2
168
  "Width of `fill-prefix' when filling a docstring.
169
The default value conforms with the de facto convention for
170
Clojure docstrings, aligning the second line with the opening
171
double quotes on the third column."
172
  :type 'integer
173
  :safe 'integerp)
174
175
(defcustom clojure-omit-space-between-tag-and-delimiters '(?\[ ?\{)
176
  "Allowed opening delimiter characters after a reader literal tag.
177
For example, \[ is allowed in :db/id[:db.part/user]."
360
  :type '(set (const :tag "[" ?\[)
178
  :type '(set (const :tag "[" ?\[)
361
              (const :tag "{" ?\{)
179
              (const :tag "{" ?\{)
362
              (const :tag "(" ?\()
180
              (const :tag "(" ?\()
363
              (const :tag "\"" ?\"))
181
              (const :tag "\"" ?\"))
364
  :group 'clojure
365
  :safe (lambda (value)
182
  :safe (lambda (value)
366
          (and (listp value)
183
          (and (listp value)
367
               (every 'characterp value))))
184
               (cl-every 'characterp value))))
368
185
369
(defvar clojure-mode-map
186
(defcustom clojure-build-tool-files '("project.clj" "build.boot" "build.gradle")
187
  "A list of files, which identify a Clojure project's root.
188
Out-of-the box `clojure-mode' understands lein, boot and gradle."
189
  :type '(repeat string)
190
  :package-version '(clojure-mode . "5.0.0")
191
  :safe (lambda (value)
192
          (and (listp value)
193
               (cl-every 'stringp value))))
194
195
(defcustom clojure-refactor-map-prefix (kbd "C-c C-r")
196
  "Clojure refactor keymap prefix."
197
  :type 'string
198
  :package-version '(clojure-mode . "5.6.0"))
199
200
(defvar clojure-refactor-map
370
  (let ((map (make-sparse-keymap)))
201
  (let ((map (make-sparse-keymap)))
371
    (set-keymap-parent map lisp-mode-shared-map)
202
    (define-key map (kbd "C-t") #'clojure-thread)
372
    (define-key map (kbd "C-M-x")   'lisp-eval-defun)
203
    (define-key map (kbd "t") #'clojure-thread)
373
    (define-key map (kbd "C-x C-e") 'lisp-eval-last-sexp)
204
    (define-key map (kbd "C-u") #'clojure-unwind)
374
    (define-key map (kbd "C-c C-e") 'lisp-eval-last-sexp)
205
    (define-key map (kbd "u") #'clojure-unwind)
375
    (define-key map (kbd "C-c C-l") 'clojure-load-file)
206
    (define-key map (kbd "C-f") #'clojure-thread-first-all)
376
    (define-key map (kbd "C-c C-r") 'lisp-eval-region)
207
    (define-key map (kbd "f") #'clojure-thread-first-all)
377
    (define-key map (kbd "C-c C-t") 'clojure-jump-between-tests-and-code)
208
    (define-key map (kbd "C-l") #'clojure-thread-last-all)
378
    (define-key map (kbd "C-c C-z") 'clojure-display-inferior-lisp-buffer)
209
    (define-key map (kbd "l") #'clojure-thread-last-all)
379
    (define-key map (kbd "C-c M-q") 'clojure-fill-docstring)
210
    (define-key map (kbd "C-a") #'clojure-unwind-all)
380
    (define-key map (kbd "C-:") 'clojure-toggle-keyword-string)
211
    (define-key map (kbd "a") #'clojure-unwind-all)
212
    (define-key map (kbd "C-p") #'clojure-cycle-privacy)
213
    (define-key map (kbd "p") #'clojure-cycle-privacy)
214
    (define-key map (kbd "C-(") #'clojure-convert-collection-to-list)
215
    (define-key map (kbd "(") #'clojure-convert-collection-to-list)
216
    (define-key map (kbd "C-'") #'clojure-convert-collection-to-quoted-list)
217
    (define-key map (kbd "'") #'clojure-convert-collection-to-quoted-list)
218
    (define-key map (kbd "C-{") #'clojure-convert-collection-to-map)
219
    (define-key map (kbd "{") #'clojure-convert-collection-to-map)
220
    (define-key map (kbd "C-[") #'clojure-convert-collection-to-vector)
221
    (define-key map (kbd "[") #'clojure-convert-collection-to-vector)
222
    (define-key map (kbd "C-#") #'clojure-convert-collection-to-set)
223
    (define-key map (kbd "#") #'clojure-convert-collection-to-set)
224
    (define-key map (kbd "C-i") #'clojure-cycle-if)
225
    (define-key map (kbd "i") #'clojure-cycle-if)
226
    (define-key map (kbd "C-w") #'clojure-cycle-when)
227
    (define-key map (kbd "w") #'clojure-cycle-when)
228
    (define-key map (kbd "C-o") #'clojure-cycle-not)
229
    (define-key map (kbd "o") #'clojure-cycle-not)
230
    (define-key map (kbd "n i") #'clojure-insert-ns-form)
231
    (define-key map (kbd "n h") #'clojure-insert-ns-form-at-point)
232
    (define-key map (kbd "n u") #'clojure-update-ns)
233
    (define-key map (kbd "n s") #'clojure-sort-ns)
234
    (define-key map (kbd "s i") #'clojure-introduce-let)
235
    (define-key map (kbd "s m") #'clojure-move-to-let)
236
    (define-key map (kbd "s f") #'clojure-let-forward-slurp-sexp)
237
    (define-key map (kbd "s b") #'clojure-let-backward-slurp-sexp)
381
    map)
238
    map)
382
  "Keymap for Clojure mode.  Inherits from `lisp-mode-shared-map'.")
239
  "Keymap for Clojure refactoring commands.")
240
(fset 'clojure-refactor-map clojure-refactor-map)
383
241
384
(easy-menu-define clojure-mode-menu clojure-mode-map
242
(defvar clojure-mode-map
385
  "Menu for Clojure mode."
243
  (let ((map (make-sparse-keymap)))
386
  '("Clojure"
244
    (define-key map (kbd "C-:") #'clojure-toggle-keyword-string)
387
    ["Eval Function Definition" lisp-eval-defun]
245
    (define-key map (kbd "C-c SPC") #'clojure-align)
388
    ["Eval Last Sexp" lisp-eval-last-sexp]
246
    (define-key map clojure-refactor-map-prefix 'clojure-refactor-map)
389
    ["Eval Region" lisp-eval-region]
247
    (easy-menu-define clojure-mode-menu map "Clojure Mode Menu"
390
    "--"
248
      '("Clojure"
391
    ["Run Inferior Lisp" clojure-display-inferior-lisp-buffer]
249
        ["Toggle between string & keyword" clojure-toggle-keyword-string]
392
    ["Display Inferior Lisp Buffer" clojure-display-inferior-lisp-buffer]
250
        ["Align expression" clojure-align]
393
    ["Load File" clojure-load-file]
251
        ["Cycle privacy" clojure-cycle-privacy]
394
    "--"
252
        ["Cycle if, if-not" clojure-cycle-if]
395
    ["Toggle between string & keyword" clojure-toggle-keyword-string]
253
        ["Cycle when, when-not" clojure-cycle-when]
396
    ["Fill Docstring" clojure-fill-docstring]
254
        ["Cycle not" clojure-cycle-not]
397
    ["Jump Between Test and Code" clojure-jump-between-tests-and-code]))
255
        ("ns forms"
256
         ["Insert ns form at the top" clojure-insert-ns-form]
257
         ["Insert ns form here" clojure-insert-ns-form-at-point]
258
         ["Update ns form" clojure-update-ns]
259
         ["Sort ns form" clojure-sort-ns])
260
        ("Convert collection"
261
         ["Convert to list" clojure-convert-collection-to-list]
262
         ["Convert to quoted list" clojure-convert-collection-to-quoted-list]
263
         ["Convert to map" clojure-convert-collection-to-map]
264
         ["Convert to vector" clojure-convert-collection-to-vector]
265
         ["Convert to set" clojure-convert-collection-to-set])
266
        ("Refactor -> and ->>"
267
         ["Thread once more" clojure-thread]
268
         ["Fully thread a form with ->" clojure-thread-first-all]
269
         ["Fully thread a form with ->>" clojure-thread-last-all]
270
         "--"
271
         ["Unwind once" clojure-unwind]
272
         ["Fully unwind a threading macro" clojure-unwind-all])
273
        ("Let expression"
274
         ["Introduce let" clojure-introduce-let]
275
         ["Move to let" clojure-move-to-let]
276
         ["Forward slurp form into let" clojure-let-forward-slurp-sexp]
277
         ["Backward slurp form into let" clojure-let-backward-slurp-sexp])
278
        ("Documentation"
279
         ["View a Clojure guide" clojure-view-guide]
280
         ["View a Clojure reference section" clojure-view-reference-section]
281
         ["View the Clojure cheatsheet" clojure-view-cheatsheet]
282
         ["View the Clojure Grimoire" clojure-view-grimoire]
283
         ["View the Clojure style guide" clojure-view-style-guide])
284
        "--"
285
        ["Report a clojure-mode bug" clojure-mode-report-bug]
286
        ["Clojure-mode version" clojure-mode-display-version]))
287
    map)
288
  "Keymap for Clojure mode.")
398
289
399
(defvar clojure-mode-syntax-table
290
(defvar clojure-mode-syntax-table
400
  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
291
  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
401
    (modify-syntax-entry ?~ "'   " table)
402
    ;; can't safely make commas whitespace since it will apply even
403
    ;; inside string literals--ick!
404
    ;; (modify-syntax-entry ?, "    " table)
405
    (modify-syntax-entry ?\{ "(}" table)
292
    (modify-syntax-entry ?\{ "(}" table)
406
    (modify-syntax-entry ?\} "){" table)
293
    (modify-syntax-entry ?\} "){" table)
407
    (modify-syntax-entry ?\[ "(]" table)
294
    (modify-syntax-entry ?\[ "(]" table)
408
    (modify-syntax-entry ?\] ")[" table)
295
    (modify-syntax-entry ?\] ")[" table)
296
    (modify-syntax-entry ?? "_ p" table) ; ? is a prefix outside symbols
297
    (modify-syntax-entry ?# "_ p" table) ; # is allowed inside keywords (#399)
298
    (modify-syntax-entry ?~ "'" table)
409
    (modify-syntax-entry ?^ "'" table)
299
    (modify-syntax-entry ?^ "'" table)
410
    ;; Make hash a usual word character
300
    (modify-syntax-entry ?@ "'" table)
411
    (modify-syntax-entry ?# "_ p" table)
301
    table)
412
    table))
302
  "Syntax table for Clojure mode.
303
Inherits from `emacs-lisp-mode-syntax-table'.")
304
305
(defconst clojure--prettify-symbols-alist
306
  '(("fn"  . ?λ)))
307
308
(defvar-local clojure-expected-ns-function nil
309
  "The function used to determine the expected namespace of a file.
310
`clojure-mode' ships a basic function named `clojure-expected-ns'
311
that does basic heuristics to figure this out.
312
CIDER provides a more complex version which does classpath analysis.")
313
314
(defun clojure-mode-display-version ()
315
  "Display the current `clojure-mode-version' in the minibuffer."
316
  (interactive)
317
  (message "clojure-mode (version %s)" clojure-mode-version))
413
318
414
(defvar clojure-prev-l/c-dir/file nil
319
(defconst clojure-mode-report-bug-url "https://github.com/clojure-emacs/clojure-mode/issues/new"
415
  "Record last directory and file used in loading or compiling.
320
  "The URL to report a `clojure-mode' issue.")
416
This holds a cons cell of the form `(DIRECTORY . FILE)'
417
describing the last `clojure-load-file' or `clojure-compile-file' command.")
418
321
419
(defvar clojure-test-ns-segment-position -1
322
(defun clojure-mode-report-bug ()
420
  "Which segment of the ns is \"test\" inserted in your test name convention.
323
  "Report a bug in your default browser."
324
  (interactive)
325
  (browse-url clojure-mode-report-bug-url))
421
326
422
Customize this depending on your project's conventions. Negative
327
(defconst clojure-guides-base-url "https://clojure.org/guides/"
423
numbers count from the end:
328
  "The base URL for official Clojure guides.")
424
329
425
  leiningen.compile -> leiningen.test.compile (uses 1)
330
(defconst clojure-guides '(("Getting Started" . "getting_started")
426
  clojure.http.client -> clojure.http.test.client (uses -1)")
331
                           ("FAQ" . "faq")
332
                           ("spec" . "spec")
333
                           ("Destructuring" . "destructuring")
334
                           ("Threading Macros" . "threading_macros")
335
                           ("Comparators" . "comparators")
336
                           ("Reader Conditionals" . "reader_conditionals"))
337
  "A list of all official Clojure guides.")
427
338
428
(defconst clojure-mode-version "2.1.0"
339
(defun clojure-view-guide ()
429
  "The current version of `clojure-mode'.")
340
  "Open a Clojure guide in your default browser.
430
341
431
(defun clojure-mode-display-version ()
342
The command will prompt you to select one of the available guides."
432
  "Display the current `clojure-mode-version' in the minibuffer."
433
  (interactive)
343
  (interactive)
434
  (message "clojure-mode (version %s)" clojure-mode-version))
344
  (let ((guide (completing-read "Select a guide: " (mapcar #'car clojure-guides))))
345
    (when guide
346
      (let ((guide-url (concat clojure-guides-base-url (cdr (assoc guide clojure-guides)))))
347
        (browse-url guide-url)))))
348
349
(defconst clojure-reference-base-url "https://clojure.org/reference/"
350
  "The base URL for the official Clojure reference.")
351
352
(defconst clojure-reference-sections '(("The Reader" . "reader")
353
                                       ("The REPL and main" . "repl_and_main")
354
                                       ("Evaluation" . "evaluation")
355
                                       ("Special Forms" . "special_forms")
356
                                       ("Macros" . "macros")
357
                                       ("Other Functions" . "other_functions")
358
                                       ("Data Structures" . "data_structures")
359
                                       ("Datatypes" . "datatypes")
360
                                       ("Sequences" . "sequences")
361
                                       ("Transients" . "transients")
362
                                       ("Transducers" . "transducers")
363
                                       ("Multimethods and Hierarchies" . "multimethods")
364
                                       ("Protocols" . "protocols")
365
                                       ("Metadata" . "metadata")
366
                                       ("Namespaces" . "namespaces")
367
                                       ("Libs" . "libs")
368
                                       ("Vars and Environments" . "vars")
369
                                       ("Refs and Transactions" . "refs")
370
                                       ("Agents" . "agents")
371
                                       ("Atoms" . "atoms")
372
                                       ("Reducers" . "reducers")
373
                                       ("Java Interop" . "java_interop")
374
                                       ("Compilation and Class Generation" . "compilation")
375
                                       ("Other Libraries" . "other_libraries")
376
                                       ("Differences with Lisps" . "lisps")))
435
377
436
;; For compatibility with Emacs < 24, derive conditionally
378
(defun clojure-view-reference-section ()
437
(defalias 'clojure-parent-mode
379
  "Open a Clojure reference section in your default browser.
438
  (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
380
381
The command will prompt you to select one of the available sections."
382
  (interactive)
383
  (let ((section (completing-read "Select a reference section: " (mapcar #'car clojure-reference-sections))))
384
    (when section
385
      (let ((section-url (concat clojure-reference-base-url (cdr (assoc section clojure-reference-sections)))))
386
        (browse-url section-url)))))
387
388
(defconst clojure-cheatsheet-url "http://clojure.org/api/cheatsheet"
389
  "The URL of the official Clojure cheatsheet.")
390
391
(defun clojure-view-cheatsheet ()
392
  "Open the Clojure cheatsheet in your default browser."
393
  (interactive)
394
  (browse-url clojure-cheatsheet-url))
395
396
(defconst clojure-grimoire-url "https://www.conj.io/"
397
  "The URL of the Grimoire community documentation site.")
398
399
(defun clojure-view-grimoire ()
400
  "Open the Clojure Grimoire in your default browser."
401
  (interactive)
402
  (browse-url clojure-grimoire-url))
403
404
(defconst clojure-style-guide-url "https://github.com/bbatsov/clojure-style-guide"
405
  "The URL of the Clojure style guide.")
406
407
(defun clojure-view-style-guide ()
408
  "Open the Clojure style guide in your default browser."
409
  (interactive)
410
  (browse-url clojure-style-guide-url))
439
411
440
(defun clojure-space-for-delimiter-p (endp delim)
412
(defun clojure-space-for-delimiter-p (endp delim)
441
  "Prevent paredit from inserting unneeded spaces."
413
  "Prevent paredit from inserting useless spaces.
442
  (if (derived-mode-p 'clojure-mode)
414
See `paredit-space-for-delimiter-predicates' for the meaning of
415
ENDP and DELIM."
416
  (or endp
417
      (not (memq delim '(?\" ?{ ?\( )))
418
      (not (or (derived-mode-p 'clojure-mode)
419
               (derived-mode-p 'cider-repl-mode)))
443
      (save-excursion
420
      (save-excursion
444
        (backward-char)
421
        (backward-char)
445
        (if (and (or (char-equal delim ?\()
422
        (cond ((eq (char-after) ?#)
446
                     (char-equal delim ?\")
423
               (and (not (bobp))
447
                     (char-equal delim ?{))
424
                    (or (char-equal ?w (char-syntax (char-before)))
448
                 (not endp))
425
                        (char-equal ?_ (char-syntax (char-before))))))
449
            (if (char-equal (char-after) ?#)
426
              ((and (eq delim ?\()
450
                (and (not (bobp))
427
                    (eq (char-after) ??)
451
                     (or (char-equal ?w (char-syntax (char-before)))
428
                    (eq (char-before) ?#))
452
                         (char-equal ?_ (char-syntax (char-before)))))
429
               nil)
453
              t)
430
              (t)))))
454
          t))
455
    t))
456
431
457
(defun clojure-no-space-after-tag (endp delimiter)
432
(defun clojure-no-space-after-tag (endp delimiter)
458
  "Do not insert a space between a reader-literal tag and an
433
  "Prevent inserting a space after a reader-literal tag?
459
  opening delimiter in the list
434
460
  clojure-omit-space-between-tag-and-delimiters. Allows you to
435
When a reader-literal tag is followed be an opening delimiter
461
  write things like #db/id[:db.part/user] without inserting a
436
listed in `clojure-omit-space-between-tag-and-delimiters', this
462
  space between the tag and the opening bracket."
437
function returns t.
438
439
This allows you to write things like #db/id[:db.part/user]
440
without inserting a space between the tag and the opening
441
bracket.
442
443
See `paredit-space-for-delimiter-predicates' for the meaning of
444
ENDP and DELIMITER."
463
  (if endp
445
  (if endp
464
      t
446
      t
465
    (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters))
447
    (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters))
Lines 471-705 Link Here
471
                       t)
453
                       t)
472
                      (= orig-point (match-end 0)))))))))
454
                      (= orig-point (match-end 0)))))))))
473
455
474
;;;###autoload
456
(declare-function paredit-open-curly "ext:paredit")
475
(define-derived-mode clojure-mode clojure-parent-mode "Clojure"
457
(declare-function paredit-close-curly "ext:paredit")
476
  "Major mode for editing Clojure code - similar to Lisp mode.
458
(declare-function paredit-convolute-sexp "ext:paredit")
477
Commands:
459
478
Delete converts tabs to spaces as it moves back.
460
(defun clojure--replace-let-bindings-and-indent (orig-fun &rest args)
479
Blank lines separate paragraphs.  Semicolons start comments.
461
  "Advise ORIG-FUN to replace let bindings.
480
\\{clojure-mode-map}
462
481
Note that `run-lisp' may be used either to start an inferior Lisp job
463
Sexps are replace by their bound name if a let form was
482
or to switch back to an existing one.
464
convoluted.
483
465
484
Entry to this mode calls the value of `clojure-mode-hook'
466
ORIG-FUN should be `paredit-convolute-sexp'.
485
if that value is non-nil."
467
486
  (setq-local imenu-create-index-function
468
ARGS are passed to ORIG-FUN, as with all advice."
487
              (lambda ()
469
  (save-excursion
488
                (imenu--generic-function '((nil clojure-match-next-def 0)))))
470
    (backward-sexp)
471
    (when (looking-back clojure--let-regexp)
472
      (clojure--replace-sexps-with-bindings-and-indent))))
473
474
(defun clojure-paredit-setup (&optional keymap)
475
  "Make \"paredit-mode\" play nice with `clojure-mode'.
476
477
If an optional KEYMAP is passed the changes are applied to it,
478
instead of to `clojure-mode-map'.
479
Also advice `paredit-convolute-sexp' when used on a let form as drop in
480
replacement for `cljr-expand-let`."
481
  (when (>= paredit-version 21)
482
    (let ((keymap (or keymap clojure-mode-map)))
483
      (define-key keymap "{" #'paredit-open-curly)
484
      (define-key keymap "}" #'paredit-close-curly))
485
    (add-to-list 'paredit-space-for-delimiter-predicates
486
                 #'clojure-space-for-delimiter-p)
487
    (add-to-list 'paredit-space-for-delimiter-predicates
488
                 #'clojure-no-space-after-tag)
489
    (advice-add 'paredit-convolute-sexp :after #'clojure--replace-let-bindings-and-indent)))
490
491
(defun clojure-mode-variables ()
492
  "Set up initial buffer-local variables for Clojure mode."
493
  (add-to-list 'imenu-generic-expression '(nil clojure-match-next-def 0))
489
  (setq-local indent-tabs-mode nil)
494
  (setq-local indent-tabs-mode nil)
490
  (lisp-mode-variables nil)
495
  (setq-local paragraph-ignore-fill-prefix t)
496
  (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\)\\|(")
497
  (setq-local outline-level 'lisp-outline-level)
498
  (setq-local comment-start ";")
499
  (setq-local comment-start-skip ";+ *")
500
  (setq-local comment-add 1) ; default to `;;' in comment-region
501
  (setq-local comment-column 40)
502
  (setq-local comment-use-syntax t)
503
  (setq-local multibyte-syntax-as-symbol t)
504
  (setq-local electric-pair-skip-whitespace 'chomp)
505
  (setq-local electric-pair-open-newline-between-pairs nil)
506
  (setq-local fill-paragraph-function #'clojure-fill-paragraph)
507
  (setq-local adaptive-fill-function #'clojure-adaptive-fill-function)
508
  (setq-local normal-auto-fill-function #'clojure-auto-fill-function)
491
  (setq-local comment-start-skip
509
  (setq-local comment-start-skip
492
              "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
510
              "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
493
  (setq-local lisp-indent-function 'clojure-indent-function)
511
  (setq-local indent-line-function #'clojure-indent-line)
494
  (when (< emacs-major-version 24)
512
  (setq-local indent-region-function #'clojure-indent-region)
495
    (setq-local forward-sexp-function 'clojure-forward-sexp))
513
  (setq-local lisp-indent-function #'clojure-indent-function)
496
  (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt)
514
  (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt)
497
  (setq-local inferior-lisp-program clojure-inf-lisp-command)
515
  (setq-local clojure-expected-ns-function #'clojure-expected-ns)
498
  (setq-local parse-sexp-ignore-comments t)
516
  (setq-local parse-sexp-ignore-comments t)
517
  (setq-local prettify-symbols-alist clojure--prettify-symbols-alist)
518
  (setq-local open-paren-in-column-0-is-defun-start nil))
519
520
;;;###autoload
521
(define-derived-mode clojure-mode prog-mode "Clojure"
522
  "Major mode for editing Clojure code.
523
524
\\{clojure-mode-map}"
525
  (clojure-mode-variables)
526
  (clojure-font-lock-setup)
527
  (add-hook 'paredit-mode-hook #'clojure-paredit-setup))
528
529
(defcustom clojure-verify-major-mode t
530
  "If non-nil, warn when activating the wrong `major-mode'."
531
  :type 'boolean
532
  :safe #'booleanp
533
  :package-version '(clojure-mode "5.3.0"))
534
535
(defun clojure--check-wrong-major-mode ()
536
  "Check if the current `major-mode' matches the file extension.
499
537
500
  (clojure-mode-font-lock-setup)
538
If it doesn't, issue a warning if `clojure-verify-major-mode' is
501
  (setq-local open-paren-in-column-0-is-defun-start nil)
539
non-nil."
502
  (add-hook 'paredit-mode-hook
540
  (when (and clojure-verify-major-mode
503
            (lambda ()
541
             (stringp (buffer-file-name)))
504
              (when (>= paredit-version 21)
542
    (let* ((case-fold-search t)
505
                (define-key clojure-mode-map "{" 'paredit-open-curly)
543
           (problem (cond ((and (string-match "\\.clj\\'" (buffer-file-name))
506
                (define-key clojure-mode-map "}" 'paredit-close-curly)
544
                                (not (eq major-mode 'clojure-mode)))
507
                (add-to-list 'paredit-space-for-delimiter-predicates
545
                           'clojure-mode)
508
                             'clojure-space-for-delimiter-p)
546
                          ((and (string-match "\\.cljs\\'" (buffer-file-name))
509
                (add-to-list 'paredit-space-for-delimiter-predicates
547
                                (not (eq major-mode 'clojurescript-mode)))
510
                             'clojure-no-space-after-tag)))))
548
                           'clojurescript-mode)
511
549
                          ((and (string-match "\\.cljc\\'" (buffer-file-name))
512
(defun clojure-display-inferior-lisp-buffer ()
550
                                (not (eq major-mode 'clojurec-mode)))
513
  "Display a buffer bound to `inferior-lisp-buffer'."
551
                           'clojurec-mode)
514
  (interactive)
552
                          ((and (string-match "\\.cljx\\'" (buffer-file-name))
515
  (if (and inferior-lisp-buffer (get-buffer inferior-lisp-buffer))
553
                                (not (eq major-mode 'clojurex-mode)))
516
      (pop-to-buffer inferior-lisp-buffer t)
554
                           'clojurex-mode))))
517
      (run-lisp inferior-lisp-program)))
555
      (when problem
518
556
        (message "[WARNING] %s activated `%s' instead of `%s' in this buffer.
519
(defun clojure-load-file (file-name)
557
This could cause problems.
520
  "Load a Clojure file FILE-NAME into the inferior Clojure process."
558
\(See `clojure-verify-major-mode' to disable this message.)"
521
  (interactive (comint-get-source "Load Clojure file: "
559
                 (if (eq major-mode real-this-command)
522
                                  clojure-prev-l/c-dir/file
560
                     "You have"
523
                                  '(clojure-mode) t))
561
                   "Something in your configuration")
524
  (comint-check-source file-name) ; Check to see if buffer needs saved.
562
                 major-mode
525
  (setq clojure-prev-l/c-dir/file (cons (file-name-directory file-name)
563
                 problem)))))
526
                                        (file-name-nondirectory file-name)))
564
527
  (comint-send-string (inferior-lisp-proc)
565
(add-hook 'clojure-mode-hook #'clojure--check-wrong-major-mode)
528
                      (format clojure-load-command file-name))
566
529
  (switch-to-lisp t))
567
(defsubst clojure-in-docstring-p ()
568
  "Check whether point is in a docstring."
569
  (let ((ppss (syntax-ppss)))
570
    ;; are we in a string?
571
    (when (nth 3 ppss)
572
      ;; check font lock at the start of the string
573
      (eq (get-text-property (nth 8 ppss) 'face)
574
          'font-lock-doc-face))))
575
576
(defsubst clojure-docstring-fill-prefix ()
577
  "The prefix string used by `clojure-fill-paragraph'.
578
It is simply `clojure-docstring-fill-prefix-width' number of spaces."
579
  (make-string clojure-docstring-fill-prefix-width ? ))
580
581
(defun clojure-adaptive-fill-function ()
582
  "Clojure adaptive fill function.
583
This only takes care of filling docstring correctly."
584
  (when (clojure-in-docstring-p)
585
    (clojure-docstring-fill-prefix)))
586
587
(defun clojure-fill-paragraph (&optional justify)
588
  "Like `fill-paragraph', but can handle Clojure docstrings.
589
If JUSTIFY is non-nil, justify as well as fill the paragraph."
590
  (if (clojure-in-docstring-p)
591
      (let ((paragraph-start
592
             (concat paragraph-start
593
                     "\\|\\s-*\\([(:\"[]\\|~@\\|`(\\|#'(\\)"))
594
            (paragraph-separate
595
             (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
596
            (fill-column (or clojure-docstring-fill-column fill-column))
597
            (fill-prefix (clojure-docstring-fill-prefix)))
598
        ;; we are in a string and string start pos (8th element) is non-nil
599
        (let* ((beg-doc (nth 8 (syntax-ppss)))
600
               (end-doc (save-excursion
601
                          (goto-char beg-doc)
602
                          (or (ignore-errors (forward-sexp) (point))
603
                              (point-max)))))
604
          (save-restriction
605
            (narrow-to-region beg-doc end-doc)
606
            (fill-paragraph justify))))
607
    (let ((paragraph-start (concat paragraph-start
608
                                   "\\|\\s-*\\([(:\"[]\\|`(\\|#'(\\)"))
609
          (paragraph-separate
610
           (concat paragraph-separate "\\|\\s-*\".*[,\\.[]$")))
611
      (or (fill-comment-paragraph justify)
612
          (fill-paragraph justify))
613
      ;; Always return `t'
614
      t)))
615
616
(defun clojure-auto-fill-function ()
617
  "Clojure auto-fill function."
618
  ;; Check if auto-filling is meaningful.
619
  (let ((fc (current-fill-column)))
620
    (when (and fc (> (current-column) fc))
621
      (let ((fill-column (if (clojure-in-docstring-p)
622
                             clojure-docstring-fill-column
623
                           fill-column))
624
            (fill-prefix (clojure-adaptive-fill-function)))
625
        (do-auto-fill)))))
530
626
531
627
628
;;; #_ comments font-locking
629
;; Code heavily borrowed from Slime.
630
;; https://github.com/slime/slime/blob/master/contrib/slime-fontifying-fu.el#L186
631
(defvar clojure--comment-macro-regexp
632
  (rx "#_" (* " ") (group-n 1 (not (any " "))))
633
  "Regexp matching the start of a comment sexp.
634
The beginning of match-group 1 should be before the sexp to be
635
marked as a comment.  The end of sexp is found with
636
`clojure-forward-logical-sexp'.")
637
638
(defvar clojure--reader-and-comment-regexp
639
  "#_ *\\(?1:[^ ]\\)\\|\\(?1:(comment\\_>\\)"
640
  "Regexp matching both `#_' macro and a comment sexp." )
641
642
(defcustom clojure-comment-regexp clojure--comment-macro-regexp
643
  "Comment mode.
644
645
The possible values for this variable are keywords indicating
646
what is considered a comment (affecting font locking).
647
648
    - Reader macro `#_' only - the default
649
    - Reader macro `#_' and `(comment)'"
650
  :type '(choice (const :tag "Reader macro `#_' and `(comment)'" clojure--reader-and-comment-regexp)
651
                 (other :tag "Reader macro `#_' only" clojure--comment-macro-regexp))
652
  :package-version '(clojure-mode . "5.7.0"))
653
654
(defun clojure--search-comment-macro-internal (limit)
655
  "Search for a comment forward stopping at LIMIT."
656
  (when (search-forward-regexp clojure-comment-regexp limit t)
657
    (let* ((md (match-data))
658
           (start (match-beginning 1))
659
           (state (syntax-ppss start)))
660
      ;; inside string or comment?
661
      (if (or (nth 3 state)
662
              (nth 4 state))
663
          (clojure--search-comment-macro-internal limit)
664
        (goto-char start)
665
        (clojure-forward-logical-sexp 1)
666
        ;; Data for (match-end 1).
667
        (setf (elt md 3) (point))
668
        (set-match-data md)
669
        t))))
670
671
(defun clojure--search-comment-macro (limit)
672
  "Find comment macros and set the match data.
673
Search from point up to LIMIT.  The region that should be
674
considered a comment is between `(match-beginning 1)'
675
and `(match-end 1)'."
676
  (let ((result 'retry))
677
    (while (and (eq result 'retry) (<= (point) limit))
678
      (condition-case nil
679
          (setq result (clojure--search-comment-macro-internal limit))
680
        (end-of-file (setq result nil))
681
        (scan-error  (setq result 'retry))))
682
    result))
532
683
684
685
;;; General font-locking
533
(defun clojure-match-next-def ()
686
(defun clojure-match-next-def ()
534
  "Scans the buffer backwards for the next top-level definition.
687
  "Scans the buffer backwards for the next \"top-level\" definition.
535
Called by `imenu--generic-function'."
688
Called by `imenu--generic-function'."
536
  (when (re-search-backward "^(def\sw*" nil t)
689
  ;; we have to take into account namespace-definition forms
690
  ;; e.g. s/defn
691
  (when (re-search-backward "^[ \t]*(\\([a-z0-9.-]+/\\)?\\(def\\sw*\\)" nil t)
537
    (save-excursion
692
    (save-excursion
538
      (let (found?
693
      (let (found?
694
            (deftype (match-string 2))
539
            (start (point)))
695
            (start (point)))
540
        (down-list)
696
        (down-list)
541
        (forward-sexp)
697
        (forward-sexp)
542
        (while (not found?)
698
        (while (not found?)
543
          (forward-sexp)
699
          (ignore-errors
544
          (or (if (char-equal ?[ (char-after (point)))
700
            (forward-sexp))
545
                              (backward-sexp))
701
          (or (when (char-equal ?\[ (char-after (point)))
546
                  (if (char-equal ?) (char-after (point)))
702
                (backward-sexp))
703
              (when (char-equal ?\) (char-after (point)))
547
                (backward-sexp)))
704
                (backward-sexp)))
548
          (destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp)
705
          (cl-destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp)
549
            (if (char-equal ?^ (char-after def-beg))
706
            (if (char-equal ?^ (char-after def-beg))
550
                (progn (forward-sexp) (backward-sexp))
707
                (progn (forward-sexp) (backward-sexp))
551
              (setq found? t)
708
              (setq found? t)
709
              (when (string= deftype "defmethod")
710
                (setq def-end (progn (goto-char def-end)
711
                                     (forward-sexp)
712
                                     (point))))
552
              (set-match-data (list def-beg def-end)))))
713
              (set-match-data (list def-beg def-end)))))
553
        (goto-char start)))))
714
        (goto-char start)))))
554
715
555
(defun clojure-mode-font-lock-setup ()
716
(eval-and-compile
717
  (defconst clojure--sym-forbidden-rest-chars "][\";\'@\\^`~\(\)\{\}\\,\s\t\n\r"
718
    "A list of chars that a Clojure symbol cannot contain.
719
See definition of 'macros': URL `http://git.io/vRGLD'.")
720
  (defconst clojure--sym-forbidden-1st-chars (concat clojure--sym-forbidden-rest-chars "0-9:")
721
    "A list of chars that a Clojure symbol cannot start with.
722
See the for-loop: URL `http://git.io/vRGTj' lines: URL
723
`http://git.io/vRGIh', URL `http://git.io/vRGLE' and value
724
definition of 'macros': URL `http://git.io/vRGLD'.")
725
  (defconst clojure--sym-regexp
726
    (concat "[^" clojure--sym-forbidden-1st-chars "][^" clojure--sym-forbidden-rest-chars "]*")
727
    "A regexp matching a Clojure symbol or namespace alias.
728
Matches the rule `clojure--sym-forbidden-1st-chars' followed by
729
any number of matches of `clojure--sym-forbidden-rest-chars'."))
730
731
(defconst clojure-font-lock-keywords
732
  (eval-when-compile
733
    `( ;; Top-level variable definition
734
      (,(concat "(\\(?:clojure.core/\\)?\\("
735
                (regexp-opt '("def" "defonce"))
736
                ;; variable declarations
737
                "\\)\\>"
738
                ;; Any whitespace
739
                "[ \r\n\t]*"
740
                ;; Possibly type or metadata
741
                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
742
                "\\(\\sw+\\)?")
743
       (1 font-lock-keyword-face)
744
       (2 font-lock-variable-name-face nil t))
745
      ;; Type definition
746
      (,(concat "(\\(?:clojure.core/\\)?\\("
747
                (regexp-opt '("defstruct" "deftype" "defprotocol"
748
                              "defrecord"))
749
                ;; type declarations
750
                "\\)\\>"
751
                ;; Any whitespace
752
                "[ \r\n\t]*"
753
                ;; Possibly type or metadata
754
                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
755
                "\\(\\sw+\\)?")
756
       (1 font-lock-keyword-face)
757
       (2 font-lock-type-face nil t))
758
      ;; Function definition (anything that starts with def and is not
759
      ;; listed above)
760
      (,(concat "(\\(?:" clojure--sym-regexp "/\\)?"
761
                "\\(def[^ \r\n\t]*\\)"
762
                ;; Function declarations
763
                "\\>"
764
                ;; Any whitespace
765
                "[ \r\n\t]*"
766
                ;; Possibly type or metadata
767
                "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"
768
                "\\(\\sw+\\)?")
769
       (1 font-lock-keyword-face)
770
       (2 font-lock-function-name-face nil t))
771
      ;; (fn name? args ...)
772
      (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+"
773
                ;; Possibly type
774
                "\\(?:#?^\\sw+[ \t]*\\)?"
775
                ;; Possibly name
776
                "\\(\\sw+\\)?" )
777
       (1 font-lock-keyword-face)
778
       (2 font-lock-function-name-face nil t))
779
      ;; lambda arguments - %, %&, %1, %2, etc
780
      ("\\<%[&1-9]?" (0 font-lock-variable-name-face))
781
      ;; Special forms
782
      (,(concat
783
         "("
784
         (regexp-opt
785
          '("def" "do" "if" "let" "let*" "var" "fn" "fn*" "loop" "loop*"
786
            "recur" "throw" "try" "catch" "finally"
787
            "set!" "new" "."
788
            "monitor-enter" "monitor-exit" "quote") t)
789
         "\\>")
790
       1 font-lock-keyword-face)
791
      ;; Built-in binding and flow of control forms
792
      (,(concat
793
         "(\\(?:clojure.core/\\)?"
794
         (regexp-opt
795
          '("letfn" "case" "cond" "cond->" "cond->>" "condp"
796
            "for" "when" "when-not" "when-let" "when-first" "when-some"
797
            "if-let" "if-not" "if-some"
798
            ".." "->" "->>" "as->" "doto" "and" "or"
799
            "dosync" "doseq" "dotimes" "dorun" "doall"
800
            "ns" "in-ns"
801
            "with-open" "with-local-vars" "binding"
802
            "with-redefs" "with-redefs-fn"
803
            "declare") t)
804
         "\\>")
805
       1 font-lock-keyword-face)
806
      ;; Macros similar to let, when, and while
807
      (,(rx symbol-start
808
            (or "let" "when" "while") "-"
809
            (1+ (or (syntax word) (syntax symbol)))
810
            symbol-end)
811
       0 font-lock-keyword-face)
812
      (,(concat
813
         "\\<"
814
         (regexp-opt
815
          '("*1" "*2" "*3" "*agent*"
816
            "*allow-unresolved-vars*" "*assert*" "*clojure-version*"
817
            "*command-line-args*" "*compile-files*"
818
            "*compile-path*" "*data-readers*" "*default-data-reader-fn*"
819
            "*e" "*err*" "*file*" "*flush-on-newline*"
820
            "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*"
821
            "*print-dup*" "*print-length*" "*print-level*"
822
            "*print-meta*" "*print-readably*"
823
            "*read-eval*" "*source-path*"
824
            "*unchecked-math*"
825
            "*use-context-classloader*" "*warn-on-reflection*")
826
          t)
827
         "\\>")
828
       0 font-lock-builtin-face)
829
      ;; Dynamic variables - *something* or @*something*
830
      ("\\(?:\\<\\|/\\)@?\\(\\*[a-z-]*\\*\\)\\>" 1 font-lock-variable-name-face)
831
      ;; Global constants - nil, true, false
832
      (,(concat
833
         "\\<"
834
         (regexp-opt
835
          '("true" "false" "nil") t)
836
         "\\>")
837
       0 font-lock-constant-face)
838
      ;; Character literals - \1, \a, \newline, \u0000
839
      ("\\\\\\([[:punct:]]\\|[a-z0-9]+\\>\\)" 0 'clojure-character-face)
840
      ;; foo/ Foo/ @Foo/ /FooBar
841
      (,(concat "\\(?:\\<:?\\|\\.\\)@?\\(" clojure--sym-regexp "\\)\\(/\\)")
842
       (1 font-lock-type-face) (2 'default))
843
      ;; Constant values (keywords), including as metadata e.g. ^:static
844
      ("\\<^?\\(:\\(\\sw\\|\\s_\\)+\\(\\>\\|\\_>\\)\\)" 1 'clojure-keyword-face append)
845
      ;; Java interop highlighting
846
      ;; CONST SOME_CONST (optionally prefixed by /)
847
      ("\\(?:\\<\\|/\\)\\([A-Z]+\\|\\([A-Z]+_[A-Z1-9_]+\\)\\)\\>" 1 font-lock-constant-face)
848
      ;; .foo .barBaz .qux01 .-flibble .-flibbleWobble
849
      ("\\<\\.-?[a-z][a-zA-Z0-9]*\\>" 0 'clojure-interop-method-face)
850
      ;; Foo Bar$Baz Qux_ World_OpenUDP Foo. Babylon15.
851
      ("\\(?:\\<\\|\\.\\|/\\|#?^\\)\\([A-Z][a-zA-Z0-9_]*[a-zA-Z0-9$_]+\\.?\\>\\)" 1 font-lock-type-face)
852
      ;; foo.bar.baz
853
      ("\\<^?\\([a-z][a-z0-9_-]+\\.\\([a-z][a-z0-9_-]*\\.?\\)+\\)" 1 font-lock-type-face)
854
      ;; (ns namespace) - special handling for single segment namespaces
855
      (,(concat "(\\<ns\\>[ \r\n\t]*"
856
                ;; Possibly metadata
857
                "\\(?:\\^?{[^}]+}[ \r\n\t]*\\)*"
858
                ;; namespace
859
                "\\([a-z0-9-]+\\)")
860
       (1 font-lock-type-face nil t))
861
      ;; fooBar
862
      ("\\(?:\\<\\|/\\)\\([a-z]+[A-Z]+[a-zA-Z0-9$]*\\>\\)" 1 'clojure-interop-method-face)
863
      ;; #_ and (comment ...) macros.
864
      (clojure--search-comment-macro 1 font-lock-comment-face t)
865
      ;; Highlight `code` marks, just like `elisp'.
866
      (,(rx "`" (group-n 1 (optional "#'")
867
                         (+ (or (syntax symbol) (syntax word)))) "`")
868
       (1 'font-lock-constant-face prepend))
869
      ;; Highlight escaped characters in strings.
870
      (clojure-font-lock-escaped-chars 0 'bold prepend)
871
      ;; Highlight grouping constructs in regular expressions
872
      (clojure-font-lock-regexp-groups
873
       (1 'font-lock-regexp-grouping-construct prepend))))
874
  "Default expressions to highlight in Clojure mode.")
875
876
(defun clojure-font-lock-syntactic-face-function (state)
877
  "Find and highlight text with a Clojure-friendly syntax table.
878
879
This function is passed to `font-lock-syntactic-face-function',
880
which is called with a single parameter, STATE (which is, in
881
turn, returned by `parse-partial-sexp' at the beginning of the
882
highlighted region)."
883
  (if (nth 3 state)
884
      ;; This might be a (doc)string or a |...| symbol.
885
      (let ((startpos (nth 8 state)))
886
        (if (eq (char-after startpos) ?|)
887
            ;; This is not a string, but a |...| symbol.
888
            nil
889
          (let* ((listbeg (nth 1 state))
890
                 (firstsym (and listbeg
891
                                (save-excursion
892
                                  (goto-char listbeg)
893
                                  (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
894
                                       (match-string 1)))))
895
                 (docelt (and firstsym
896
                              (function-get (intern-soft firstsym)
897
                                            lisp-doc-string-elt-property))))
898
            (if (and docelt
899
                     ;; It's a string in a form that can have a docstring.
900
                     ;; Check whether it's in docstring position.
901
                     (save-excursion
902
                       (when (functionp docelt)
903
                         (goto-char (match-end 1))
904
                         (setq docelt (funcall docelt)))
905
                       (goto-char listbeg)
906
                       (forward-char 1)
907
                       (ignore-errors
908
                         (while (and (> docelt 0) (< (point) startpos)
909
                                     (progn (forward-sexp 1) t))
910
                           ;; ignore metadata and type hints
911
                           (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)")
912
                             (setq docelt (1- docelt)))))
913
                       (and (zerop docelt) (<= (point) startpos)
914
                            (progn (forward-comment (point-max)) t)
915
                            (= (point) (nth 8 state)))))
916
                font-lock-doc-face
917
              font-lock-string-face))))
918
    font-lock-comment-face))
919
920
(defun clojure-font-lock-setup ()
556
  "Configures font-lock for editing Clojure code."
921
  "Configures font-lock for editing Clojure code."
557
  (interactive)
558
  (setq-local font-lock-multiline t)
922
  (setq-local font-lock-multiline t)
559
  (add-to-list 'font-lock-extend-region-functions
923
  (add-to-list 'font-lock-extend-region-functions
560
               'clojure-font-lock-extend-region-def t)
924
               #'clojure-font-lock-extend-region-def t)
561
562
  (when clojure-font-lock-comment-sexp
563
    (add-to-list 'font-lock-extend-region-functions
564
                 'clojure-font-lock-extend-region-comment t)
565
    (make-local-variable 'clojure-font-lock-keywords)
566
    (add-to-list 'clojure-font-lock-keywords
567
                 'clojure-font-lock-mark-comment t)
568
    (setq-local open-paren-in-column-0-is-defun-start nil))
569
570
  (setq font-lock-defaults
925
  (setq font-lock-defaults
571
        '(clojure-font-lock-keywords    ; keywords
926
        '(clojure-font-lock-keywords    ; keywords
572
          nil nil
927
          nil nil
573
          (("+-*/.<>=!?$%_&~^:@" . "w")) ; syntax alist
928
          (("+-*/.<>=!?$%_&:" . "w")) ; syntax alist
574
          nil
929
          nil
575
          (font-lock-mark-block-function . mark-defun)
930
          (font-lock-mark-block-function . mark-defun)
576
          (font-lock-syntactic-face-function
931
          (font-lock-syntactic-face-function
577
           . lisp-font-lock-syntactic-face-function))))
932
           . clojure-font-lock-syntactic-face-function))))
578
933
579
(defun clojure-font-lock-def-at-point (point)
934
(defun clojure-font-lock-def-at-point (point)
580
  "Find the position range between the top-most def* and the
935
  "Range between the top-most def* and the fourth element after POINT.
581
fourth element afterwards using POINT.  Note that this means there's no
936
Note that this means that there is no guarantee of proper font
582
guarantee of proper font locking in def* forms that are not at
937
locking in def* forms that are not at top level."
583
top level."
584
  (goto-char point)
938
  (goto-char point)
585
  (condition-case nil
939
  (ignore-errors
586
      (beginning-of-defun)
940
    (beginning-of-defun))
587
    (error nil))
588
941
589
  (let ((beg-def (point)))
942
  (let ((beg-def (point)))
590
    (when (and (not (= point beg-def))
943
    (when (and (not (= point beg-def))
591
               (looking-at "(def"))
944
               (looking-at "(def"))
592
      (condition-case nil
945
      (ignore-errors
593
          (progn
946
        ;; move forward as much as possible until failure (or success)
594
            ;; move forward as much as possible until failure (or success)
947
        (forward-char)
595
            (forward-char)
948
        (dotimes (_ 4)
596
            (dotimes (i 4)
949
          (forward-sexp)))
597
              (forward-sexp)))
598
        (error nil))
599
      (cons beg-def (point)))))
950
      (cons beg-def (point)))))
600
951
601
(defun clojure-font-lock-extend-region-def ()
952
(defun clojure-font-lock-extend-region-def ()
602
  "Move fontification boundaries to always include the first four
953
  "Set region boundaries to include the first four elements of def* forms."
603
elements of a def* forms."
604
  (let ((changed nil))
954
  (let ((changed nil))
605
    (let ((def (clojure-font-lock-def-at-point font-lock-beg)))
955
    (let ((def (clojure-font-lock-def-at-point font-lock-beg)))
606
      (when def
956
      (when def
607
        (destructuring-bind (def-beg . def-end) def
957
        (cl-destructuring-bind (def-beg . def-end) def
608
          (when (and (< def-beg font-lock-beg)
958
          (when (and (< def-beg font-lock-beg)
609
                     (< font-lock-beg def-end))
959
                     (< font-lock-beg def-end))
610
            (setq font-lock-beg def-beg
960
            (setq font-lock-beg def-beg
611
                  changed t)))))
961
                  changed t)))))
612
613
    (let ((def (clojure-font-lock-def-at-point font-lock-end)))
962
    (let ((def (clojure-font-lock-def-at-point font-lock-end)))
614
      (when def
963
      (when def
615
        (destructuring-bind (def-beg . def-end) def
964
        (cl-destructuring-bind (def-beg . def-end) def
616
          (when (and (< def-beg font-lock-end)
965
          (when (and (< def-beg font-lock-end)
617
                     (< font-lock-end def-end))
966
                     (< font-lock-end def-end))
618
            (setq font-lock-end def-end
967
            (setq font-lock-end def-end
619
                  changed t)))))
968
                  changed t)))))
620
    changed))
969
    changed))
621
970
622
(defun clojure-mode-font-lock-regexp-groups (bound)
971
(defun clojure--font-locked-as-string-p (&optional regexp)
623
  "Highlight grouping constructs in regular expression.
972
  "Non-nil if the char before point is font-locked as a string.
624
973
If REGEXP is non-nil, also check whether current string is
625
BOUND denotes the maximum number of characters (relative to the point) to check."
974
preceeded by a #."
626
  (catch 'found
975
  (let ((face (get-text-property (1- (point)) 'face)))
627
    (while (re-search-forward (concat
976
    (and (or (and (listp face)
628
                               ;; A group may start using several alternatives:
977
                  (memq 'font-lock-string-face face))
629
                               "\\(\\(?:"
978
             (eq 'font-lock-string-face face))
630
                               ;; 1. (? special groups
979
         (or (clojure-string-start t)
631
                               "(\\?\\(?:"
980
             (unless regexp
632
                               ;; a) non-capturing group (?:X)
981
               (clojure-string-start nil))))))
633
                               ;; b) independent non-capturing group (?>X)
982
634
                               ;; c) zero-width positive lookahead (?=X)
983
(defun clojure-font-lock-escaped-chars (bound)
635
                               ;; d) zero-width negative lookahead (?!X)
984
  "Highlight \escaped chars in strings.
636
                               "[:=!>]\\|"
985
BOUND denotes a buffer position to limit the search."
637
                               ;; e) zero-width positive lookbehind (?<=X)
986
  (let ((found nil))
638
                               ;; f) zero-width negative lookbehind (?<!X)
987
    (while (and (not found)
639
                               "<[=!]\\|"
988
                (re-search-forward "\\\\." bound t))
640
                               ;; g) named capturing group (?<name>X)
641
                               "<[[:alnum:]]+>"
642
                               "\\)\\|" ;; end of special groups
643
                               ;; 2. normal capturing groups (
644
                               ;; 3. we also highlight alternative
645
                               ;; separarators |, and closing parens )
646
                               "[|()]"
647
                               "\\)\\)") bound t)
648
      (let ((face (get-text-property (1- (point)) 'face)))
649
        (when (and (or (and (listp face)
650
                            (memq 'font-lock-string-face face))
651
                       (eq 'font-lock-string-face face))
652
                   (clojure-string-start t))
653
          (throw 'found t))))))
654
655
(defun clojure-find-block-comment-start (limit)
656
  "Search for (comment...) or #_ style block comments.
657
Places point at the beginning of the expression.
658
659
LIMIT denotes the maximum number of characters (relative to the point) to check."
660
  (let ((pos (re-search-forward "\\((comment\\>\\|#_\\)" limit t)))
661
    (when pos
662
      (forward-char (- (length (match-string 1))))
663
      pos)))
664
989
665
(defun clojure-font-lock-extend-region-comment ()
990
      (setq found (clojure--font-locked-as-string-p)))
666
  "Move fontification boundaries to always contain entire (comment ..) and #_ sexp.
991
    found))
667
668
Does not work if you have a  whitespace between ( and comment, but that is omitted to make
669
this run faster."
670
  (let ((changed nil))
671
    (goto-char font-lock-beg)
672
    (condition-case nil (beginning-of-defun) (error nil))
673
    (let ((pos (clojure-find-block-comment-start font-lock-end)))
674
      (when pos
675
        (when (< (point) font-lock-beg)
676
          (setq font-lock-beg (point)
677
                changed t))
678
        (condition-case nil (forward-sexp) (error nil))
679
        (when (> (point) font-lock-end)
680
          (setq font-lock-end (point)
681
                changed t))))
682
    changed))
683
992
684
(defun clojure-font-lock-mark-comment (limit)
993
(defun clojure-font-lock-regexp-groups (bound)
685
  "Mark all (comment ..) and #_ forms with `font-lock-comment-face'.
994
  "Highlight grouping constructs in regular expression.
686
995
687
LIMIT denotes the maximum number of characters (relative to the point) to check."
996
BOUND denotes the maximum number of characters (relative to the
688
  (let (pos)
997
point) to check."
689
    (while (and (< (point) limit)
998
  (let ((found nil))
690
                (setq pos (clojure-find-block-comment-start limit)))
999
    (while (and (not found)
691
      (when pos
1000
                (re-search-forward (eval-when-compile
692
        (condition-case nil
1001
                                     (concat
693
            (add-text-properties (point)
1002
                                      ;; A group may start using several alternatives:
694
                                 (progn
1003
                                      "\\(\\(?:"
695
                                   (forward-sexp)
1004
                                      ;; 1. (? special groups
696
                                   (point))
1005
                                      "(\\?\\(?:"
697
                                 '(face font-lock-comment-face multiline t))
1006
                                      ;; a) non-capturing group (?:X)
698
          (error (forward-char 8))))))
1007
                                      ;; b) independent non-capturing group (?>X)
699
  nil)
1008
                                      ;; c) zero-width positive lookahead (?=X)
1009
                                      ;; d) zero-width negative lookahead (?!X)
1010
                                      "[:=!>]\\|"
1011
                                      ;; e) zero-width positive lookbehind (?<=X)
1012
                                      ;; f) zero-width negative lookbehind (?<!X)
1013
                                      "<[=!]\\|"
1014
                                      ;; g) named capturing group (?<name>X)
1015
                                      "<[[:alnum:]]+>"
1016
                                      "\\)\\|" ;; end of special groups
1017
                                      ;; 2. normal capturing groups (
1018
                                      ;; 3. we also highlight alternative
1019
                                      ;; separarators |, and closing parens )
1020
                                      "[|()]"
1021
                                      "\\)\\)"))
1022
                                   bound t))
1023
      (setq found (clojure--font-locked-as-string-p 'regexp)))
1024
    found))
700
1025
701
;; Docstring positions
1026
;; Docstring positions
702
(put 'ns 'clojure-doc-string-elt 2)
1027
(put 'ns 'clojure-doc-string-elt 2)
1028
(put 'def 'clojure-doc-string-elt 2)
703
(put 'defn 'clojure-doc-string-elt 2)
1029
(put 'defn 'clojure-doc-string-elt 2)
704
(put 'defn- 'clojure-doc-string-elt 2)
1030
(put 'defn- 'clojure-doc-string-elt 2)
705
(put 'defmulti 'clojure-doc-string-elt 2)
1031
(put 'defmulti 'clojure-doc-string-elt 2)
Lines 707-899 Link Here
707
(put 'definline 'clojure-doc-string-elt 2)
1033
(put 'definline 'clojure-doc-string-elt 2)
708
(put 'defprotocol 'clojure-doc-string-elt 2)
1034
(put 'defprotocol 'clojure-doc-string-elt 2)
709
1035
710
1036
;;; Vertical alignment
711
1037
(defcustom clojure-align-forms-automatically nil
712
(defun clojure-forward-sexp (n)
1038
  "If non-nil, vertically align some forms automatically.
713
  "Treat record literals like #user.Foo[1] and #user.Foo{:size 1}
1039
Automatically means it is done as part of indenting code.  This
714
as a single sexp so that slime will send them properly. Arguably
1040
applies to binding forms (`clojure-align-binding-forms'), to cond
715
this behavior is unintuitive for the user pressing (eg) C-M-f
1041
forms (`clojure-align-cond-forms') and to map literals.  For
716
himself, but since these are single objects I think it's right."
1042
instance, selecting a map a hitting \\<clojure-mode-map>`\\[indent-for-tab-command]'
717
  (let ((dir (if (> n 0) 1 -1))
1043
will align the values like this:
718
        (forward-sexp-function nil)) ; force the built-in version
1044
    {:some-key 10
719
    (while (not (zerop n))
1045
     :key2     20}"
720
      (forward-sexp dir)
1046
  :package-version '(clojure-mode . "5.1")
721
      (when (save-excursion ; move back to see if we're in a record literal
1047
  :safe #'booleanp
722
              (and
1048
  :type 'boolean)
723
               (condition-case nil
1049
724
                   (progn (backward-sexp) 't)
1050
(defcustom clojure-align-binding-forms
725
                 ('scan-error nil))
1051
  '("let" "when-let" "when-some" "if-let" "if-some" "binding" "loop"
726
               (looking-at "#\\w")))
1052
    "doseq" "for" "with-open" "with-local-vars" "with-redefs")
727
        (forward-sexp dir)) ; if so, jump over it
1053
  "List of strings matching forms that have binding forms."
728
      (setq n (- n dir)))))
1054
  :package-version '(clojure-mode . "5.1")
1055
  :safe #'listp
1056
  :type '(repeat string))
1057
1058
(defcustom clojure-align-cond-forms '("condp" "cond" "cond->" "cond->>" "case" "are")
1059
  "List of strings identifying cond-like forms."
1060
  :package-version '(clojure-mode . "5.1")
1061
  :safe #'listp
1062
  :type '(repeat string))
1063
1064
(defun clojure--position-for-alignment ()
1065
  "Non-nil if the sexp around point should be automatically aligned.
1066
This function expects to be called immediately after an
1067
open-brace or after the function symbol in a function call.
1068
1069
First check if the sexp around point is a map literal, or is a
1070
call to one of the vars listed in `clojure-align-cond-forms'.  If
1071
it isn't, return nil.  If it is, return non-nil and place point
1072
immediately before the forms that should be aligned.
1073
1074
For instance, in a map literal point is left immediately before
1075
the first key; while, in a let-binding, point is left inside the
1076
binding vector and immediately before the first binding
1077
construct."
1078
  ;; Are we in a map?
1079
  (or (and (eq (char-before) ?{)
1080
           (not (eq (char-before (1- (point))) ?\#)))
1081
      ;; Are we in a cond form?
1082
      (let* ((fun    (car (member (thing-at-point 'symbol) clojure-align-cond-forms)))
1083
             (method (and fun (clojure--get-indent-method fun)))
1084
             ;; The number of special arguments in the cond form is
1085
             ;; the number of sexps we skip before aligning.
1086
             (skip   (cond ((numberp method) method)
1087
                           ((null method) 0)
1088
                           ((sequencep method) (elt method 0)))))
1089
        (when (and fun (numberp skip))
1090
          (clojure-forward-logical-sexp skip)
1091
          (comment-forward (point-max))
1092
          fun)) ; Return non-nil (the var name).
1093
      ;; Are we in a let-like form?
1094
      (when (member (thing-at-point 'symbol)
1095
                    clojure-align-binding-forms)
1096
        ;; Position inside the binding vector.
1097
        (clojure-forward-logical-sexp)
1098
        (backward-sexp)
1099
        (when (eq (char-after) ?\[)
1100
          (forward-char 1)
1101
          (comment-forward (point-max))
1102
          ;; Return non-nil.
1103
          t))))
1104
1105
(defun clojure--find-sexp-to-align (end)
1106
  "Non-nil if there's a sexp ahead to be aligned before END.
1107
Place point as in `clojure--position-for-alignment'."
1108
  ;; Look for a relevant sexp.
1109
  (let ((found))
1110
    (while (and (not found)
1111
                (search-forward-regexp
1112
                 (concat "{\\|(" (regexp-opt
1113
                                  (append clojure-align-binding-forms
1114
                                          clojure-align-cond-forms)
1115
                                  'symbols))
1116
                 end 'noerror))
1117
1118
      (let ((ppss (syntax-ppss)))
1119
        ;; If we're in a string or comment.
1120
        (unless (or (elt ppss 3)
1121
                    (elt ppss 4))
1122
          ;; Only stop looking if we successfully position
1123
          ;; the point.
1124
          (setq found (clojure--position-for-alignment)))))
1125
    found))
1126
1127
(defun clojure--search-whitespace-after-next-sexp (&optional bound _noerror)
1128
  "Move point after all whitespace after the next sexp.
1129
1130
Set the match data group 1 to be this region of whitespace and
1131
return point.
1132
1133
BOUND is bounds the whitespace search."
1134
  (unwind-protect
1135
      (ignore-errors
1136
        (clojure-forward-logical-sexp 1)
1137
        (search-forward-regexp "\\([,\s\t]*\\)" bound)
1138
        (pcase (syntax-after (point))
1139
          ;; End-of-line, try again on next line.
1140
          (`(12) (clojure--search-whitespace-after-next-sexp bound))
1141
          ;; Closing paren, stop here.
1142
          (`(5 . ,_) nil)
1143
          ;; Anything else is something to align.
1144
          (_ (point))))
1145
    (when (and bound (> (point) bound))
1146
      (goto-char bound))))
1147
1148
(defun clojure-align (beg end)
1149
  "Vertically align the contents of the sexp around point.
1150
If region is active, align it.  Otherwise, align everything in the
1151
current \"top-level\" sexp.
1152
When called from lisp code align everything between BEG and END."
1153
  (interactive (if (use-region-p)
1154
                   (list (region-beginning) (region-end))
1155
                 (save-excursion
1156
                   (let ((end (progn (end-of-defun)
1157
                                     (point))))
1158
                     (clojure-backward-logical-sexp)
1159
                     (list (point) end)))))
1160
  (setq end (copy-marker end))
1161
  (save-excursion
1162
    (goto-char beg)
1163
    (while (clojure--find-sexp-to-align end)
1164
      (let ((sexp-end (save-excursion
1165
                        (backward-up-list)
1166
                        (forward-sexp 1)
1167
                        (point-marker)))
1168
            (clojure-align-forms-automatically nil)
1169
            (count 1))
1170
        ;; For some bizarre reason, we need to `align-region' once for each
1171
        ;; group.
1172
        (save-excursion
1173
          (while (search-forward-regexp "^ *\n" sexp-end 'noerror)
1174
            (cl-incf count)))
1175
        (dotimes (_ count)
1176
          (align-region (point) sexp-end nil
1177
                        '((clojure-align (regexp . clojure--search-whitespace-after-next-sexp)
1178
                                         (group . 1)
1179
                                         (separate . "^ *$")
1180
                                         (repeat . t)))
1181
                        nil))
1182
        ;; Reindent after aligning because of #360.
1183
        (indent-region (point) sexp-end)))))
1184
1185
;;; Indentation
1186
(defun clojure-indent-region (beg end)
1187
  "Like `indent-region', but also maybe align forms.
1188
Forms between BEG and END are aligned according to
1189
`clojure-align-forms-automatically'."
1190
  (prog1 (let ((indent-region-function nil))
1191
           (indent-region beg end))
1192
    (when clojure-align-forms-automatically
1193
      (condition-case nil
1194
          (clojure-align beg end)
1195
        (scan-error nil)))))
729
1196
1197
(defun clojure-indent-line ()
1198
  "Indent current line as Clojure code."
1199
  (if (clojure-in-docstring-p)
1200
      (save-excursion
1201
        (beginning-of-line)
1202
        (when (and (looking-at "^\\s-*")
1203
                   (<= (string-width (match-string-no-properties 0))
1204
                       (string-width (clojure-docstring-fill-prefix))))
1205
          (replace-match (clojure-docstring-fill-prefix))))
1206
    (lisp-indent-line)))
1207
1208
(defvar clojure-get-indent-function nil
1209
  "Function to get the indent spec of a symbol.
1210
This function should take one argument, the name of the symbol as
1211
a string.  This name will be exactly as it appears in the buffer,
1212
so it might start with a namespace alias.
1213
1214
This function is analogous to the `clojure-indent-function'
1215
symbol property, and its return value should match one of the
1216
allowed values of this property.  See `clojure-indent-function'
1217
for more information.")
1218
1219
(defun clojure--get-indent-method (function-name)
1220
  "Return the indent spec for the symbol named FUNCTION-NAME.
1221
FUNCTION-NAME is a string.  If it contains a `/', also try only
1222
the part after the `/'.
1223
1224
Look for a spec using `clojure-get-indent-function', then try the
1225
`clojure-indent-function' and `clojure-backtracking-indent'
1226
symbol properties."
1227
  (or (when (functionp clojure-get-indent-function)
1228
        (funcall clojure-get-indent-function function-name))
1229
      (get (intern-soft function-name) 'clojure-indent-function)
1230
      (get (intern-soft function-name) 'clojure-backtracking-indent)
1231
      (when (string-match "/\\([^/]+\\)\\'" function-name)
1232
        (or (get (intern-soft (match-string 1 function-name))
1233
                 'clojure-indent-function)
1234
            (get (intern-soft (match-string 1 function-name))
1235
                 'clojure-backtracking-indent)))
1236
      (when (string-match (rx (or "let" "when" "while") (syntax symbol))
1237
                          function-name)
1238
        (clojure--get-indent-method (substring (match-string 0 function-name) 0 -1)))))
1239
1240
(defvar clojure--current-backtracking-depth 0)
1241
1242
(defun clojure--find-indent-spec-backtracking ()
1243
  "Return the indent sexp that applies to the sexp at point.
1244
Implementation function for `clojure--find-indent-spec'."
1245
  (when (and (>= clojure-max-backtracking clojure--current-backtracking-depth)
1246
             (not (looking-at "^")))
1247
    (let ((clojure--current-backtracking-depth (1+ clojure--current-backtracking-depth))
1248
          (pos 0))
1249
      ;; Count how far we are from the start of the sexp.
1250
      (while (ignore-errors (clojure-backward-logical-sexp 1)
1251
                            (not (or (bobp)
1252
                                     (eq (char-before) ?\n))))
1253
        (cl-incf pos))
1254
      (let* ((function (thing-at-point 'symbol))
1255
             (method (or (when function ;; Is there a spec here?
1256
                           (clojure--get-indent-method function))
1257
                         (ignore-errors
1258
                           ;; Otherwise look higher up.
1259
                           (pcase (syntax-ppss)
1260
                             (`(,(pred (< 0)) ,start . ,_)
1261
                              (goto-char start)
1262
                              (clojure--find-indent-spec-backtracking)))))))
1263
        (when (numberp method)
1264
          (setq method (list method)))
1265
        (pcase method
1266
          ((pred functionp)
1267
           (when (= pos 0)
1268
             method))
1269
          ((pred sequencep)
1270
           (pcase (length method)
1271
             (`0 nil)
1272
             (`1 (let ((head (elt method 0)))
1273
                   (when (or (= pos 0) (sequencep head))
1274
                     head)))
1275
             (l (if (>= pos l)
1276
                    (elt method (1- l))
1277
                  (elt method pos)))))
1278
          ((or `defun `:defn)
1279
           (when (= pos 0)
1280
             :defn))
1281
          (_
1282
           (message "Invalid indent spec for `%s': %s" function method)
1283
           nil))))))
1284
1285
(defun clojure--find-indent-spec ()
1286
  "Return the indent spec that applies to current sexp.
1287
If `clojure-use-backtracking-indent' is non-nil, also do
1288
backtracking up to a higher-level sexp in order to find the
1289
spec."
1290
  (if clojure-use-backtracking-indent
1291
      (save-excursion
1292
        (clojure--find-indent-spec-backtracking))
1293
    (let ((function (thing-at-point 'symbol)))
1294
      (clojure--get-indent-method function))))
1295
1296
(defun clojure--normal-indent (last-sexp indent-mode)
1297
  "Return the normal indentation column for a sexp.
1298
Point should be after the open paren of the _enclosing_ sexp, and
1299
LAST-SEXP is the start of the previous sexp (immediately before
1300
the sexp being indented).  INDENT-MODE is any of the values
1301
accepted by `clojure-indent-style'."
1302
  (goto-char last-sexp)
1303
  (forward-sexp 1)
1304
  (clojure-backward-logical-sexp 1)
1305
  (let ((last-sexp-start nil))
1306
    (if (ignore-errors
1307
          ;; `backward-sexp' until we reach the start of a sexp that is the
1308
          ;; first of its line (the start of the enclosing sexp).
1309
          (while (string-match
1310
                  "[^[:blank:]]"
1311
                  (buffer-substring (line-beginning-position) (point)))
1312
            (setq last-sexp-start (prog1 (point)
1313
                                    (forward-sexp -1))))
1314
          t)
1315
        ;; Here we have found an arg before the arg we're indenting which is at
1316
        ;; the start of a line. Every mode simply aligns on this case.
1317
        (current-column)
1318
      ;; Here we have reached the start of the enclosing sexp (point is now at
1319
      ;; the function name), so the behaviour depends on INDENT-MODE and on
1320
      ;; whether there's also an argument on this line (case A or B).
1321
      (let ((case-a ; The meaning of case-a is explained in `clojure-indent-style'.
1322
             (and last-sexp-start
1323
                  (< last-sexp-start (line-end-position)))))
1324
        (cond
1325
         ;; For compatibility with the old `clojure-defun-style-default-indent', any
1326
         ;; value other than these 3 is equivalent to `always-body'.
1327
         ((not (memq indent-mode '(:always-align :align-arguments nil)))
1328
          (+ (current-column) lisp-body-indent -1))
1329
         ;; There's an arg after the function name, so align with it.
1330
         (case-a (goto-char last-sexp-start)
1331
                 (current-column))
1332
         ;; Not same line.
1333
         ((eq indent-mode :align-arguments)
1334
          (+ (current-column) lisp-body-indent -1))
1335
         ;; Finally, just align with the function name.
1336
         (t (current-column)))))))
1337
1338
(defun clojure--not-function-form-p ()
1339
  "Non-nil if form at point doesn't represent a function call."
1340
  (or (member (char-after) '(?\[ ?\{))
1341
      (save-excursion ;; Catch #?@ (:cljs ...)
1342
        (skip-chars-backward "\r\n[:blank:]")
1343
        (when (eq (char-before) ?@)
1344
          (forward-char -1))
1345
        (and (eq (char-before) ?\?)
1346
             (eq (char-before (1- (point))) ?\#)))
1347
      ;; Car of form is not a symbol.
1348
      (not (looking-at ".\\(?:\\sw\\|\\s_\\)"))))
1349
1350
;; Check the general context, and provide indentation for data structures and
1351
;; special macros. If current form is a function (or non-special macro),
1352
;; delegate indentation to `clojure--normal-indent'.
730
(defun clojure-indent-function (indent-point state)
1353
(defun clojure-indent-function (indent-point state)
731
  "This function is the normal value of the variable `lisp-indent-function'.
1354
  "When indenting a line within a function call, indent properly.
732
It is used when indenting a line within a function call, to see if the
733
called function says anything special about how to indent the line.
734
1355
735
INDENT-POINT is the position where the user typed TAB, or equivalent.
1356
INDENT-POINT is the position where the user typed TAB, or equivalent.
736
Point is located at the point to indent under (for default indentation);
1357
Point is located at the point to indent under (for default indentation);
737
STATE is the `parse-partial-sexp' state for that position.
1358
STATE is the `parse-partial-sexp' state for that position.
738
1359
739
If the current line is in a call to a Lisp function
1360
If the current line is in a call to a Clojure function with a
740
which has a non-nil property `lisp-indent-function',
1361
non-nil property `clojure-indent-function', that specifies how to do
741
that specifies how to do the indentation.  The property value can be
1362
the indentation.
742
* `defun', meaning indent `defun'-style;
1363
743
* an integer N, meaning indent the first N arguments specially
1364
The property value can be
1365
1366
- `defun', meaning indent `defun'-style;
1367
- an integer N, meaning indent the first N arguments specially
744
  like ordinary function arguments and then indent any further
1368
  like ordinary function arguments and then indent any further
745
  arguments like a body;
1369
  arguments like a body;
746
* a function to call just as this function was called.
1370
- a function to call just as this function was called.
747
  If that function returns nil, that means it doesn't specify
1371
  If that function returns nil, that means it doesn't specify
748
  the indentation.
1372
  the indentation.
1373
- a list, which is used by `clojure-backtracking-indent'.
749
1374
750
This function also returns nil meaning don't specify the indentation."
1375
This function also returns nil meaning don't specify the indentation."
751
  (let ((normal-indent (current-column)))
1376
  ;; Goto to the open-paren.
752
    (goto-char (1+ (elt state 1)))
1377
  (goto-char (elt state 1))
753
    (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
1378
  ;; Maps, sets, vectors and reader conditionals.
754
    (if (and (elt state 2)
1379
  (if (clojure--not-function-form-p)
755
             (not (looking-at "\\sw\\|\\s_")))
1380
      (1+ (current-column))
756
        ;; car of form doesn't seem to be a symbol
1381
    ;; Function or macro call.
757
        (progn
1382
    (forward-char 1)
758
          (if (not (> (save-excursion (forward-line 1) (point))
1383
    (let ((method (clojure--find-indent-spec))
759
                      calculate-lisp-indent-last-sexp))
1384
          (last-sexp calculate-lisp-indent-last-sexp)
760
              (progn (goto-char calculate-lisp-indent-last-sexp)
1385
          (containing-form-column (1- (current-column))))
761
                     (beginning-of-line)
1386
      (pcase method
762
                     (parse-partial-sexp (point)
1387
        ((or (pred integerp) `(,method))
763
                                         calculate-lisp-indent-last-sexp 0 t)))
1388
         (let ((pos -1))
764
          ;; Indent under the list or under the first sexp on the same
1389
           (condition-case nil
765
          ;; line as calculate-lisp-indent-last-sexp.  Note that first
1390
               (while (and (<= (point) indent-point)
766
          ;; thing on that line has to be complete sexp since we are
1391
                           (not (eobp)))
767
          ;; inside the innermost containing sexp.
1392
                 (clojure-forward-logical-sexp 1)
768
          (backward-prefix-chars)
1393
                 (cl-incf pos))
769
          (if (and (eq (char-after (point)) ?\[)
1394
             ;; If indent-point is _after_ the last sexp in the
770
                   (eq (char-after (elt state 1)) ?\())
1395
             ;; current sexp, we detect that by catching the
771
              (+ (current-column) 2) ;; this is probably inside a defn
1396
             ;; `scan-error'. In that case, we should return the
772
            (current-column)))
1397
             ;; indentation as if there were an extra sexp at point.
773
      (let* ((function (buffer-substring (point)
1398
             (scan-error (cl-incf pos)))
774
                                         (progn (forward-sexp 1) (point))))
1399
           (cond
775
             (open-paren (elt state 1))
1400
            ;; The first non-special arg. Rigidly reduce indentation.
776
             (method nil)
1401
            ((= pos (1+ method))
777
             (function-tail (first
1402
             (+ lisp-body-indent containing-form-column))
778
                             (last
1403
            ;; Further non-special args, align with the arg above.
779
                              (split-string (substring-no-properties function) "/")))))
1404
            ((> pos (1+ method))
780
        (setq method (get (intern-soft function-tail) 'clojure-indent-function))
1405
             (clojure--normal-indent last-sexp :always-align))
781
1406
            ;; Special arg. Rigidly indent with a large indentation.
782
        (cond ((member (char-after open-paren) '(?\[ ?\{))
1407
            (t
783
               (goto-char open-paren)
1408
             (+ (* 2 lisp-body-indent) containing-form-column)))))
784
               (1+ (current-column)))
1409
        (`:defn
785
              ((or (eq method 'defun)
1410
         (+ lisp-body-indent containing-form-column))
786
                   (and clojure-defun-style-default-indent
1411
        ((pred functionp)
787
                        ;; largely to preserve useful alignment of :require, etc in ns
1412
         (funcall method indent-point state))
788
                        (not (string-match "^:" function))
1413
        ;; No indent spec, do the default.
789
                        (not method))
1414
        (`nil
790
                   (and (null method)
1415
         (let ((function (thing-at-point 'symbol)))
791
                        (> (length function) 3)
1416
           (cond
792
                        (string-match "\\`\\(?:\\S +/\\)?\\(def\\|with-\\)"
1417
            ;; Preserve useful alignment of :require (and friends) in `ns' forms.
793
                                      function)))
1418
            ((and function (string-match "^:" function))
794
               (lisp-indent-defform state indent-point))
1419
             (clojure--normal-indent last-sexp :always-align))
795
1420
            ;; This is should be identical to the :defn above.
796
              ((integerp method)
1421
            ((and function
797
               (lisp-indent-specform method state
1422
                  (string-match "\\`\\(?:\\S +/\\)?\\(def[a-z]*\\|with-\\)"
798
                                     indent-point normal-indent))
1423
                                function)
799
              (method
1424
                  (not (string-match "\\`default" (match-string 1 function))))
800
               (funcall method indent-point state))
1425
             (+ lisp-body-indent containing-form-column))
801
              (clojure-use-backtracking-indent
1426
            ;; Finally, nothing special here, just respect the user's
802
               (clojure-backtracking-indent
1427
            ;; preference.
803
                indent-point state normal-indent)))))))
1428
            (t (clojure--normal-indent last-sexp clojure-indent-style)))))))))
804
805
(defun clojure-backtracking-indent (indent-point state normal-indent)
806
  "Experimental backtracking support.
807
808
Will upwards in an sexp to check for contextual indenting."
809
  (let (indent (path) (depth 0))
810
    (goto-char (elt state 1))
811
    (while (and (not indent)
812
                (< depth clojure-max-backtracking))
813
      (let ((containing-sexp (point)))
814
        (parse-partial-sexp (1+ containing-sexp) indent-point 1 t)
815
        (when (looking-at "\\sw\\|\\s_")
816
          (let* ((start (point))
817
                 (fn (buffer-substring start (progn (forward-sexp 1) (point))))
818
                 (meth (get (intern-soft fn) 'clojure-backtracking-indent)))
819
            (let ((n 0))
820
              (when (< (point) indent-point)
821
                (condition-case ()
822
                    (progn
823
                      (forward-sexp 1)
824
                      (while (< (point) indent-point)
825
                        (parse-partial-sexp (point) indent-point 1 t)
826
                        (incf n)
827
                        (forward-sexp 1)))
828
                  (error nil)))
829
              (push n path))
830
            (when meth
831
              (let ((def meth))
832
                (dolist (p path)
833
                  (if (and (listp def)
834
                           (< p (length def)))
835
                      (setq def (nth p def))
836
                    (if (listp def)
837
                        (setq def (car (last def)))
838
                      (setq def nil))))
839
                (goto-char (elt state 1))
840
                (when def
841
                  (setq indent (+ (current-column) def)))))))
842
        (goto-char containing-sexp)
843
        (condition-case ()
844
            (progn
845
              (backward-up-list 1)
846
              (incf depth))
847
          (error (setq depth clojure-max-backtracking)))))
848
    indent))
849
850
;; clojure backtracking indent is experimental and the format for these
851
;; entries are subject to change
852
(put 'implement 'clojure-backtracking-indent '(4 (2)))
853
(put 'letfn 'clojure-backtracking-indent '((2) 2))
854
(put 'proxy 'clojure-backtracking-indent '(4 4 (2)))
855
(put 'reify 'clojure-backtracking-indent '((2)))
856
(put 'deftype 'clojure-backtracking-indent '(4 4 (2)))
857
(put 'defrecord 'clojure-backtracking-indent '(4 4 (2)))
858
(put 'defprotocol 'clojure-backtracking-indent '(4 (2)))
859
(put 'extend-type 'clojure-backtracking-indent '(4 (2)))
860
(put 'extend-protocol 'clojure-backtracking-indent '(4 (2)))
861
1429
1430
;;; Setting indentation
862
(defun put-clojure-indent (sym indent)
1431
(defun put-clojure-indent (sym indent)
1432
  "Instruct `clojure-indent-function' to indent the body of SYM by INDENT."
863
  (put sym 'clojure-indent-function indent))
1433
  (put sym 'clojure-indent-function indent))
864
1434
865
(defmacro define-clojure-indent (&rest kvs)
1435
(defmacro define-clojure-indent (&rest kvs)
1436
  "Call `put-clojure-indent' on a series, KVS."
866
  `(progn
1437
  `(progn
867
     ,@(mapcar (lambda (x) `(put-clojure-indent
1438
     ,@(mapcar (lambda (x) `(put-clojure-indent
868
                        (quote ,(first x)) ,(second x))) kvs)))
1439
                             (quote ,(car x)) ,(cadr x)))
1440
               kvs)))
869
1441
870
(defun add-custom-clojure-indents (name value)
1442
(defun add-custom-clojure-indents (name value)
1443
  "Allow `clojure-defun-indents' to indent user-specified macros.
1444
1445
Requires the macro's NAME and a VALUE."
871
  (custom-set-default name value)
1446
  (custom-set-default name value)
872
  (mapcar (lambda (x)
1447
  (mapcar (lambda (x)
873
            (put-clojure-indent x 'defun))
1448
            (put-clojure-indent x 'defun))
874
          value))
1449
          value))
875
1450
876
(defcustom clojure-defun-indents nil
1451
(defcustom clojure-defun-indents nil
877
  "List of symbols to give defun-style indentation to in Clojure
1452
  "List of additional symbols with defun-style indentation in Clojure.
878
code, in addition to those that are built-in. You can use this to
1453
879
get emacs to indent your own macros the same as it does the
1454
You can use this to let Emacs indent your own macros the same way
880
built-ins like with-open. To set manually from lisp code,
1455
that it indents built-in macros like with-open.  This variable
881
use (put-clojure-indent 'some-symbol 'defun)."
1456
only works when set via the customize interface (`setq' won't
1457
work).  To set it from Lisp code, use
1458
     (put-clojure-indent \\='some-symbol :defn)."
882
  :type '(repeat symbol)
1459
  :type '(repeat symbol)
883
  :group 'clojure
884
  :set 'add-custom-clojure-indents)
1460
  :set 'add-custom-clojure-indents)
885
1461
886
(define-clojure-indent
1462
(define-clojure-indent
887
  ;; built-ins
1463
  ;; built-ins
888
  (ns 1)
1464
  (ns 1)
889
  (fn 'defun)
1465
  (fn :defn)
890
  (def 'defun)
1466
  (def :defn)
891
  (defn 'defun)
1467
  (defn :defn)
892
  (bound-fn 'defun)
1468
  (bound-fn :defn)
893
  (if 1)
1469
  (if 1)
894
  (if-not 1)
1470
  (if-not 1)
895
  (case 1)
1471
  (case 1)
1472
  (cond 0)
896
  (condp 2)
1473
  (condp 2)
1474
  (cond-> 1)
1475
  (cond->> 1)
897
  (when 1)
1476
  (when 1)
898
  (while 1)
1477
  (while 1)
899
  (when-not 1)
1478
  (when-not 1)
Lines 903-928 Link Here
903
  (comment 0)
1482
  (comment 0)
904
  (doto 1)
1483
  (doto 1)
905
  (locking 1)
1484
  (locking 1)
906
  (proxy 2)
1485
  (proxy '(2 nil nil (:defn)))
907
  (with-open 1)
1486
  (as-> 2)
908
  (with-precision 1)
909
  (with-local-vars 1)
910
911
  (reify 'defun)
912
  (deftype 2)
913
  (defrecord 2)
914
  (defprotocol 1)
915
  (extend 1)
916
  (extend-protocol 1)
917
  (extend-type 1)
918
1487
1488
  (reify '(:defn (1)))
1489
  (deftype '(2 nil nil (:defn)))
1490
  (defrecord '(2 nil nil (:defn)))
1491
  (defprotocol '(1 (:defn)))
1492
  (definterface '(1 (:defn)))
1493
  (extend 1)
1494
  (extend-protocol '(1 :defn))
1495
  (extend-type '(1 :defn))
1496
  ;; specify and specify! are from ClojureScript
1497
  (specify '(1 :defn))
1498
  (specify! '(1 :defn))
919
  (try 0)
1499
  (try 0)
920
  (catch 2)
1500
  (catch 2)
921
  (finally 0)
1501
  (finally 0)
922
1502
923
  ;; binding forms
1503
  ;; binding forms
924
  (let 1)
1504
  (let 1)
925
  (letfn 1)
1505
  (letfn '(1 ((:defn)) nil))
926
  (binding 1)
1506
  (binding 1)
927
  (loop 1)
1507
  (loop 1)
928
  (for 1)
1508
  (for 1)
Lines 930-948 Link Here
930
  (dotimes 1)
1510
  (dotimes 1)
931
  (when-let 1)
1511
  (when-let 1)
932
  (if-let 1)
1512
  (if-let 1)
1513
  (when-some 1)
1514
  (if-some 1)
1515
  (this-as 1) ; ClojureScript
933
1516
934
  ;; data structures
1517
  (defmethod :defn)
935
  (defstruct 1)
936
  (struct-map 1)
937
  (assoc 1)
938
939
  (defmethod 'defun)
940
1518
941
  ;; clojure.test
1519
  ;; clojure.test
942
  (testing 1)
1520
  (testing 1)
943
  (deftest 'defun)
1521
  (deftest :defn)
944
  (are 1)
1522
  (are 2)
945
  (use-fixtures 'defun))
1523
  (use-fixtures :defn)
1524
1525
  ;; core.logic
1526
  (run :defn)
1527
  (run* :defn)
1528
  (fresh :defn)
1529
1530
  ;; core.async
1531
  (alt! 0)
1532
  (alt!! 0)
1533
  (go 0)
1534
  (go-loop 1)
1535
  (thread 0))
946
1536
947
1537
948
1538
Lines 954-962 Link Here
954
1544
955
(defun clojure-string-start (&optional regex)
1545
(defun clojure-string-start (&optional regex)
956
  "Return the position of the \" that begins the string at point.
1546
  "Return the position of the \" that begins the string at point.
957
If REGEX is non-nil, return the position of the # that begins
1547
If REGEX is non-nil, return the position of the # that begins the
958
the regex at point.  If point is not inside a string or regex,
1548
regex at point.  If point is not inside a string or regex, return
959
return nil."
1549
nil."
960
  (when (nth 3 (syntax-ppss)) ;; Are we really in a string?
1550
  (when (nth 3 (syntax-ppss)) ;; Are we really in a string?
961
    (save-excursion
1551
    (save-excursion
962
      (save-match-data
1552
      (save-match-data
Lines 966-1031 Link Here
966
        (let ((beg (match-beginning 2)))
1556
        (let ((beg (match-beginning 2)))
967
          (when beg
1557
          (when beg
968
            (if regex
1558
            (if regex
969
                (and (char-equal ?# (char-before beg)) (1- beg))
1559
                (and (char-before beg) (eq ?# (char-before beg)) (1- beg))
970
              (when (not (char-equal ?# (char-before beg)))
1560
              (when (not (eq ?# (char-before beg)))
971
                beg))))))))
1561
                beg))))))))
972
1562
973
(defun clojure-char-at-point ()
1563
(defun clojure-char-at-point ()
974
  "Return the char at point or nil if at buffer end."
1564
  "Return the char at point or nil if at buffer end."
975
  (when (not (= (point) (point-max)))
1565
  (when (not (= (point) (point-max)))
976
   (buffer-substring-no-properties (point) (1+ (point)))))
1566
    (buffer-substring-no-properties (point) (1+ (point)))))
977
1567
978
(defun clojure-char-before-point ()
1568
(defun clojure-char-before-point ()
979
  "Return the char before point or nil if at buffer beginning."
1569
  "Return the char before point or nil if at buffer beginning."
980
  (when (not (= (point) (point-min)))
1570
  (when (not (= (point) (point-min)))
981
    (buffer-substring-no-properties (point) (1- (point)))))
1571
    (buffer-substring-no-properties (point) (1- (point)))))
982
1572
983
;; TODO: Deal with the fact that when point is exactly at the
984
;; beginning of a string, it thinks that is the end.
985
(defun clojure-string-end ()
986
  "Return the position of the \" that ends the string at point.
987
988
Note that point must be inside the string - if point is
989
positioned at the opening quote, incorrect results will be
990
returned."
991
  (save-excursion
992
    (save-match-data
993
      ;; If we're at the end of the string, just return point.
994
      (if (and (string= (clojure-char-at-point) "\"")
995
               (not (string= (clojure-char-before-point) "\\")))
996
          (point)
997
        ;; We don't want to get screwed by starting out at the
998
        ;; backslash in an escaped quote.
999
        (when (string= (clojure-char-at-point) "\\")
1000
          (backward-char))
1001
        ;; Look for a quote not preceeded by a backslash
1002
        (re-search-forward "[^\\]\\\(\\\"\\)")
1003
        (match-beginning 1)))))
1004
1005
(defun clojure-docstring-start+end-points ()
1006
  "Return the start and end points of the string at point as a cons."
1007
  (if (and (fboundp 'paredit-string-start+end-points) paredit-mode)
1008
      (paredit-string-start+end-points)
1009
    (cons (clojure-string-start) (clojure-string-end))))
1010
1011
(defun clojure-mark-string ()
1012
  "Mark the string at point."
1013
  (interactive)
1014
  (goto-char (clojure-string-start))
1015
  (forward-char)
1016
  (set-mark (clojure-string-end)))
1017
1018
(defun clojure-toggle-keyword-string ()
1573
(defun clojure-toggle-keyword-string ()
1019
  "Convert the string or keyword at (point) from string->keyword or keyword->string."
1574
  "Convert the string or keyword at point to keyword or string."
1020
  (interactive)
1575
  (interactive)
1021
  (let* ((original-point (point)))
1576
  (let ((original-point (point)))
1022
    (while (and (> (point) 1)
1577
    (while (and (> (point) 1)
1023
                (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))))
1578
                (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))))
1024
                (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))))
1579
                (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))))
1025
      (backward-char))
1580
      (backward-char))
1026
    (cond
1581
    (cond
1027
     ((equal 1 (point))
1582
     ((equal 1 (point))
1028
      (message "beginning of file reached, this was probably a mistake."))
1583
      (error "Beginning of file reached, this was probably a mistake"))
1029
     ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))
1584
     ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))
1030
      (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1)))
1585
      (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1)))
1031
     ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))
1586
     ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point))))
Lines 1033-1086 Link Here
1033
    (goto-char original-point)))
1588
    (goto-char original-point)))
1034
1589
1035
(defun clojure-delete-and-extract-sexp ()
1590
(defun clojure-delete-and-extract-sexp ()
1036
  "Delete the sexp and return it."
1591
  "Delete the surrounding sexp and return it."
1037
  (interactive)
1592
  (let ((begin (point)))
1038
  (let* ((begin (point)))
1039
    (forward-sexp)
1593
    (forward-sexp)
1040
    (let* ((result (buffer-substring-no-properties begin (point))))
1594
    (let ((result (buffer-substring begin (point))))
1041
      (delete-region begin (point))
1595
      (delete-region begin (point))
1042
      result)))
1596
      result)))
1043
1597
1044
(defvar clojure-docstring-indent-level 2)
1598
1045
1599
1046
(defun clojure-fill-docstring ()
1600
(defun clojure-project-dir (&optional dir-name)
1047
  "Fill the definition that the point is on appropriate for Clojure.
1601
  "Return the absolute path to the project's root directory.
1048
1602
1049
Fills so that every paragraph has a minimum of two initial spaces,
1603
Use `default-directory' if DIR-NAME is nil.
1050
with the exception of the first line.  Fill margins are taken from
1604
Return nil if not inside a project."
1051
paragraph start, so a paragraph that begins with four spaces will
1605
  (let* ((dir-name (or dir-name default-directory))
1052
remain indented by four spaces after refilling."
1606
         (choices (delq nil
1053
  (interactive)
1607
                        (mapcar (lambda (fname)
1054
  (if (and (fboundp 'paredit-in-string-p) paredit-mode)
1608
                                  (locate-dominating-file dir-name fname))
1055
      (unless (paredit-in-string-p)
1609
                                clojure-build-tool-files))))
1056
        (error "Must be inside a string")))
1610
    (when (> (length choices) 0)
1057
  ;; Oddly, save-excursion doesn't do a good job of preserving point.
1611
      (car (sort choices #'file-in-directory-p)))))
1058
  ;; It's probably because we delete the string and then re-insert it.
1612
1059
  (let ((old-point (point)))
1613
(defun clojure-project-relative-path (path)
1060
    (save-restriction
1614
  "Denormalize PATH by making it relative to the project root."
1061
      (save-excursion
1615
  (file-relative-name path (clojure-project-dir)))
1062
        (let* ((clojure-fill-column fill-column)
1063
               (string-region (clojure-docstring-start+end-points))
1064
               (string-start (car string-region))
1065
               (string-end (cdr string-region))
1066
               (string (buffer-substring-no-properties string-start
1067
                                                       string-end)))
1068
          (delete-region string-start string-end)
1069
          (insert
1070
           (with-temp-buffer
1071
             (insert string)
1072
             (let ((left-margin clojure-docstring-indent-level))
1073
               (delete-trailing-whitespace)
1074
               (setq fill-column clojure-fill-column)
1075
               (fill-region (point-min) (point-max))
1076
               (buffer-substring-no-properties (+ clojure-docstring-indent-level (point-min)) (point-max))))))))
1077
    (goto-char old-point)))
1078
1616
1079
1617
1618
;;; ns manipulation
1619
(defun clojure-expected-ns (&optional path)
1620
  "Return the namespace matching PATH.
1621
1622
PATH is expected to be an absolute file path.
1623
1624
If PATH is nil, use the path to the file backing the current buffer."
1625
  (let* ((path (or path (file-truename (buffer-file-name))))
1626
         (relative (clojure-project-relative-path path))
1627
         (sans-file-type (substring relative 0 (- (length (file-name-extension path t)))))
1628
         (sans-file-sep (mapconcat 'identity (cdr (split-string sans-file-type "/")) "."))
1629
         (sans-underscores (replace-regexp-in-string "_" "-" sans-file-sep)))
1630
    ;; Drop prefix from ns for projects with structure src/{clj,cljs,cljc}
1631
    (replace-regexp-in-string "\\`clj[scx]?\\." "" sans-underscores)))
1632
1633
(defun clojure-insert-ns-form-at-point ()
1634
  "Insert a namespace form at point."
1635
  (interactive)
1636
  (insert (format "(ns %s)" (funcall clojure-expected-ns-function))))
1637
1638
(defun clojure-insert-ns-form ()
1639
  "Insert a namespace form at the beginning of the buffer."
1640
  (interactive)
1641
  (widen)
1642
  (goto-char (point-min))
1643
  (clojure-insert-ns-form-at-point))
1644
1645
(defun clojure-update-ns ()
1646
  "Update the namespace of the current buffer.
1647
Useful if a file has been renamed."
1648
  (interactive)
1649
  (let ((nsname (funcall clojure-expected-ns-function)))
1650
    (when nsname
1651
      (save-excursion
1652
        (save-match-data
1653
          (if (clojure-find-ns)
1654
              (progn (replace-match nsname nil nil nil 4)
1655
                     (message "ns form updated"))
1656
            (error "Namespace not found")))))))
1657
1658
(defun clojure--sort-following-sexps ()
1659
  "Sort sexps between point and end of current sexp.
1660
Comments at the start of a line are considered part of the
1661
following sexp.  Comments at the end of a line (after some other
1662
content) are considered part of the preceding sexp."
1663
  ;; Here we're after the :require/:import symbol.
1664
  (save-restriction
1665
    (narrow-to-region (point) (save-excursion
1666
                                (up-list)
1667
                                (1- (point))))
1668
    (skip-chars-forward "\r\n[:blank:]")
1669
    (sort-subr nil
1670
               (lambda () (skip-chars-forward "\r\n[:blank:]"))
1671
               ;; Move to end of current top-level thing.
1672
               (lambda ()
1673
                 (condition-case nil
1674
                     (while t (up-list))
1675
                   (scan-error nil))
1676
                 ;; We could be inside a symbol instead of a sexp.
1677
                 (unless (looking-at "\\s-\\|$")
1678
                   (clojure-forward-logical-sexp))
1679
                 ;; move past comments at the end of the line.
1680
                 (search-forward-regexp "$"))
1681
               ;; Move to start of ns name.
1682
               (lambda ()
1683
                 (comment-forward)
1684
                 (skip-chars-forward "[:blank:]\n\r[(")
1685
                 (clojure-forward-logical-sexp)
1686
                 (forward-sexp -1)
1687
                 nil)
1688
               ;; Move to end of ns name.
1689
               (lambda ()
1690
                 (clojure-forward-logical-sexp)))
1691
    (goto-char (point-max))
1692
    ;; Does the last line now end in a comment?
1693
    (when (nth 4 (parse-partial-sexp (point-min) (point)))
1694
      (insert "\n"))))
1695
1696
(defun clojure-sort-ns ()
1697
  "Internally sort each sexp inside the ns form."
1698
  (interactive)
1699
  (comment-normalize-vars)
1700
  (if (clojure-find-ns)
1701
      (save-excursion
1702
        (goto-char (match-beginning 0))
1703
        (redisplay)
1704
        (let ((beg (point))
1705
              (ns))
1706
          (forward-sexp 1)
1707
          (setq ns (buffer-substring beg (point)))
1708
          (forward-char -1)
1709
          (while (progn (forward-sexp -1)
1710
                        (looking-at "(:[a-z]"))
1711
            (save-excursion
1712
              (forward-char 1)
1713
              (forward-sexp 1)
1714
              (clojure--sort-following-sexps)))
1715
          (goto-char beg)
1716
          (if (looking-at (regexp-quote ns))
1717
              (message "ns form is already sorted")
1718
            (sleep-for 0.1)
1719
            (redisplay)
1720
            (message "ns form has been sorted")
1721
            (sleep-for 0.1))))
1722
    (user-error "Namespace not found")))
1080
1723
1081
(defconst clojure-namespace-name-regex
1724
(defconst clojure-namespace-name-regex
1082
  (rx line-start
1725
  (rx line-start
1083
      (zero-or-more whitespace)
1084
      "("
1726
      "("
1085
      (zero-or-one (group (regexp "clojure.core/")))
1727
      (zero-or-one (group (regexp "clojure.core/")))
1086
      (zero-or-one (submatch "in-"))
1728
      (zero-or-one (submatch "in-"))
Lines 1094-1226 Link Here
1094
                        (zero-or-more "^:"
1736
                        (zero-or-more "^:"
1095
                                      (one-or-more (not (any whitespace)))))
1737
                                      (one-or-more (not (any whitespace)))))
1096
                    (one-or-more (any whitespace "\n")))
1738
                    (one-or-more (any whitespace "\n")))
1097
      ;; why is this here? oh (in-ns 'foo) or (ns+ :user)
1739
      (zero-or-one (any ":'")) ;; (in-ns 'foo) or (ns+ :user)
1098
      (zero-or-one (any ":'"))
1740
      (group (one-or-more (not (any "()\"" whitespace))) symbol-end)))
1099
      (group (one-or-more (not (any "()\"" whitespace))) word-end)))
1741
1100
1742
(defun clojure-find-ns ()
1101
;; for testing clojure-namespace-name-regex, you can evaluate this code and make
1743
  "Return the namespace of the current Clojure buffer.
1102
;; sure foo (or whatever the namespace name is) shows up in results. some of
1744
Return the namespace closest to point and above it.  If there are
1103
;; these currently fail.
1745
no namespaces above point, return the first one in the buffer."
1104
;; (mapcar (lambda (s) (let ((n (string-match clojure-namespace-name-regex s)))
1746
  (save-excursion
1105
;;                       (if n (match-string 4 s))))
1747
    (save-restriction
1106
;;         '("(ns foo)"
1748
      (widen)
1107
;;           "(ns
1749
      ;; The closest ns form above point.
1108
;; foo)"
1750
      (when (or (re-search-backward clojure-namespace-name-regex nil t)
1109
;;           "(ns foo.baz)"
1751
                ;; Or any form at all.
1110
;;           "(ns ^:bar foo)"
1752
                (and (goto-char (point-min))
1111
;;           "(ns ^:bar ^:baz foo)"
1753
                     (re-search-forward clojure-namespace-name-regex nil t)))
1112
;;           "(ns ^{:bar true} foo)"
1754
        (match-string-no-properties 4)))))
1113
;;           "(ns #^{:bar true} foo)"
1755
1114
;;           "(ns #^{:fail {}} foo)"
1756
(defconst clojure-def-type-and-name-regex
1115
;;           "(ns ^{:fail2 {}} foo.baz)"
1757
  (concat "(\\(?:\\(?:\\sw\\|\\s_\\)+/\\)?"
1116
;;           "(ns ^{} foo)"
1758
          ;; Declaration
1117
;;           "(ns ^{:skip-wiki true}
1759
          "\\(def\\(?:\\sw\\|\\s_\\)*\\)\\>"
1118
;;   aleph.netty
1760
          ;; Any whitespace
1119
;; "
1761
          "[ \r\n\t]*"
1120
;;           "(ns
1762
          ;; Possibly type or metadata
1121
;;  foo)"
1763
          "\\(?:#?^\\(?:{[^}]*}\\|\\(?:\\sw\\|\\s_\\)+\\)[ \r\n\t]*\\)*"
1122
;;     "foo"))
1764
          ;; Symbol name
1765
          "\\(\\(?:\\sw\\|\\s_\\)+\\)"))
1766
1767
(defun clojure-find-def ()
1768
  "Find the var declaration macro and symbol name of the current form.
1769
Returns a list pair, e.g. (\"defn\" \"abc\") or (\"deftest\" \"some-test\")."
1770
  (save-excursion
1771
    (unless (looking-at clojure-def-type-and-name-regex)
1772
      (beginning-of-defun))
1773
    (when (search-forward-regexp clojure-def-type-and-name-regex nil t)
1774
      (list (match-string-no-properties 1)
1775
            (match-string-no-properties 2)))))
1123
1776
1124
1777
1778
;;; Sexp navigation
1779
(defun clojure--looking-at-non-logical-sexp ()
1780
  "Return non-nil if text after point is \"non-logical\" sexp.
1781
\"Non-logical\" sexp are ^metadata and #reader.macros."
1782
  (comment-normalize-vars)
1783
  (comment-forward (point-max))
1784
  (looking-at-p "\\^\\|#[[:alpha:]]"))
1785
1786
(defun clojure-forward-logical-sexp (&optional n)
1787
  "Move forward N logical sexps.
1788
This will skip over sexps that don't represent objects, so that ^hints and
1789
#reader.macros are considered part of the following sexp."
1790
  (interactive "p")
1791
  (unless n (setq n 1))
1792
  (if (< n 0)
1793
      (clojure-backward-logical-sexp (- n))
1794
    (let ((forward-sexp-function nil))
1795
      (while (> n 0)
1796
        (while (clojure--looking-at-non-logical-sexp)
1797
          (forward-sexp 1))
1798
        ;; The actual sexp
1799
        (forward-sexp 1)
1800
        (skip-chars-forward ",")
1801
        (setq n (1- n))))))
1802
1803
(defun clojure-backward-logical-sexp (&optional n)
1804
  "Move backward N logical sexps.
1805
This will skip over sexps that don't represent objects, so that ^hints and
1806
#reader.macros are considered part of the following sexp."
1807
  (interactive "p")
1808
  (unless n (setq n 1))
1809
  (if (< n 0)
1810
      (clojure-forward-logical-sexp (- n))
1811
    (let ((forward-sexp-function nil))
1812
      (while (> n 0)
1813
        ;; The actual sexp
1814
        (backward-sexp 1)
1815
        ;; Non-logical sexps.
1816
        (while (and (not (bobp))
1817
                    (ignore-errors
1818
                      (save-excursion
1819
                        (backward-sexp 1)
1820
                        (clojure--looking-at-non-logical-sexp))))
1821
          (backward-sexp 1))
1822
        (setq n (1- n))))))
1823
1824
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1825
;;
1826
;; Refactoring support
1827
;;
1828
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1125
1829
1126
(defun clojure-expected-ns ()
1830
;;; Threading macros related
1127
  "Return the namespace name that the file should have."
1831
(defcustom clojure-thread-all-but-last nil
1128
  (let* ((project-dir (file-truename
1832
  "Non-nil means do not thread the last expression.
1129
                       (locate-dominating-file default-directory
1833
This means that `clojure-thread-first-all' and
1130
                                               "project.clj")))
1834
`clojure-thread-last-all' not thread the deepest sexp inside the
1131
         (relative (substring (file-truename (buffer-file-name))
1835
current sexp."
1132
                              (length project-dir)
1836
  :package-version '(clojure-mode . "5.4.0")
1133
                              (- (length (file-name-extension (buffer-file-name) t))))))
1837
  :safe #'booleanp
1134
    (replace-regexp-in-string
1838
  :type 'boolean)
1135
     "_" "-" (mapconcat 'identity (cdr (split-string relative "/")) "."))))
1136
1839
1137
(defun clojure-insert-ns-form-at-point ()
1840
(defun clojure--point-after (&rest actions)
1138
  "Insert a namespace form at point."
1841
  "Return POINT after performing ACTIONS.
1139
  (interactive)
1140
  (insert (format "(ns %s)" (clojure-expected-ns))))
1141
1842
1142
(defun clojure-insert-ns-form ()
1843
An action is either the symbol of a function or a two element
1143
  "Insert a namespace form at the beginning of the buffer."
1844
list of (fn args) to pass to `apply''"
1845
  (save-excursion
1846
    (dolist (fn-and-args actions)
1847
      (let ((f (if (listp fn-and-args) (car fn-and-args) fn-and-args))
1848
            (args (if (listp fn-and-args) (cdr fn-and-args) nil)))
1849
        (apply f args)))
1850
    (point)))
1851
1852
(defun clojure--maybe-unjoin-line ()
1853
  "Undo a `join-line' done by a threading command."
1854
  (when (get-text-property (point) 'clojure-thread-line-joined)
1855
    (remove-text-properties (point) (1+ (point)) '(clojure-thread-line-joined t))
1856
    (insert "\n")))
1857
1858
(defun clojure--unwind-last ()
1859
  "Unwind a thread last macro once.
1860
1861
Point must be between the opening paren and the ->> symbol."
1862
  (forward-sexp)
1863
  (save-excursion
1864
    (let ((beg (point))
1865
          (contents (clojure-delete-and-extract-sexp)))
1866
      (when (looking-at " *\n")
1867
        (join-line 'following))
1868
      (clojure--ensure-parens-around-function-names)
1869
      (let* ((sexp-beg-line (line-number-at-pos))
1870
             (sexp-end-line (progn (forward-sexp)
1871
                                   (line-number-at-pos)))
1872
             (multiline-sexp-p (not (= sexp-beg-line sexp-end-line))))
1873
        (down-list -1)
1874
        (if multiline-sexp-p
1875
            (insert "\n")
1876
          ;; `clojure--maybe-unjoin-line' only works when unwinding sexps that were
1877
          ;; threaded in the same Emacs session, but it also catches cases that
1878
          ;; `multiline-sexp-p' doesn't.
1879
          (clojure--maybe-unjoin-line))
1880
        (insert contents))))
1881
  (forward-char))
1882
1883
(defun clojure--ensure-parens-around-function-names ()
1884
  "Insert parens around function names if necessary."
1885
  (clojure--looking-at-non-logical-sexp)
1886
  (unless (looking-at "(")
1887
    (insert-parentheses 1)
1888
    (backward-up-list)))
1889
1890
(defun clojure--unwind-first ()
1891
  "Unwind a thread first macro once.
1892
1893
Point must be between the opening paren and the -> symbol."
1894
  (forward-sexp)
1895
  (save-excursion
1896
    (let ((contents (clojure-delete-and-extract-sexp)))
1897
      (when (looking-at " *\n")
1898
        (join-line 'following))
1899
      (clojure--ensure-parens-around-function-names)
1900
      (down-list)
1901
      (forward-sexp)
1902
      (insert contents)
1903
      (forward-sexp -1)
1904
      (clojure--maybe-unjoin-line)))
1905
  (forward-char))
1906
1907
(defun clojure--pop-out-of-threading ()
1908
  "Raise a sexp up a level to unwind a threading form."
1909
  (save-excursion
1910
    (down-list 2)
1911
    (backward-up-list)
1912
    (raise-sexp)))
1913
1914
(defun clojure--nothing-more-to-unwind ()
1915
  "Return non-nil if a threaded form cannot be unwound further."
1916
  (save-excursion
1917
    (let ((beg (point)))
1918
      (forward-sexp)
1919
      (down-list -1)
1920
      (backward-sexp 2) ;; the last sexp, the threading macro
1921
      (when (looking-back "(\\s-*" (line-beginning-position))
1922
        (backward-up-list)) ;; and the paren
1923
      (= beg (point)))))
1924
1925
(defun clojure--fix-sexp-whitespace (&optional move-out)
1926
  "Fix whitespace after unwinding a threading form.
1927
1928
Optional argument MOVE-OUT, if non-nil, means moves up a list
1929
before fixing whitespace."
1930
  (save-excursion
1931
    (when move-out (backward-up-list))
1932
    (let ((sexp (bounds-of-thing-at-point 'sexp)))
1933
      (clojure-indent-region (car sexp) (cdr sexp))
1934
      (delete-trailing-whitespace (car sexp) (cdr sexp)))))
1935
1936
;;;###autoload
1937
(defun clojure-unwind ()
1938
  "Unwind thread at point or above point by one level.
1939
Return nil if there are no more levels to unwind."
1144
  (interactive)
1940
  (interactive)
1145
  (goto-char (point-min))
1941
  (save-excursion
1146
  (clojure-insert-ns-form-at-point))
1942
    (let ((limit (save-excursion
1943
                   (beginning-of-defun)
1944
                   (point))))
1945
      (ignore-errors
1946
        (when (looking-at "(")
1947
          (forward-char 1)
1948
          (forward-sexp 1)))
1949
      (search-backward-regexp "([^-]*->" limit)
1950
      (if (clojure--nothing-more-to-unwind)
1951
          (progn (clojure--pop-out-of-threading)
1952
                 (clojure--fix-sexp-whitespace)
1953
                 nil)
1954
        (down-list)
1955
        (prog1 (cond
1956
                ((looking-at "[^-]*->\\_>")  (clojure--unwind-first))
1957
                ((looking-at "[^-]*->>\\_>") (clojure--unwind-last)))
1958
          (clojure--fix-sexp-whitespace 'move-out))
1959
        t))))
1147
1960
1148
(defun clojure-update-ns ()
1961
;;;###autoload
1149
  "Update the namespace of the current buffer.
1962
(defun clojure-unwind-all ()
1150
Useful if a file has been renamed."
1963
  "Fully unwind thread at point or above point."
1151
  (interactive)
1964
  (interactive)
1152
  (let ((nsname (clojure-expected-ns)))
1965
  (while (clojure-unwind)))
1153
    (when nsname
1154
      (save-restriction
1155
        (save-excursion
1156
          (save-match-data
1157
            (if (clojure-find-ns)
1158
                (replace-match nsname nil nil nil 4)
1159
              (error "Namespace not found"))))))))
1160
1966
1161
(defun clojure-find-ns ()
1967
(defun clojure--remove-superfluous-parens ()
1162
  "Find the namespace of the current Clojure buffer."
1968
  "Remove extra parens from a form."
1163
  (let ((regexp clojure-namespace-name-regex))
1969
  (when (looking-at "([^ )]+)")
1164
    (save-restriction
1970
    (delete-pair)))
1971
1972
(defun clojure--thread-first ()
1973
  "Thread a nested sexp using ->."
1974
  (down-list)
1975
  (forward-symbol 1)
1976
  (unless (looking-at ")")
1977
    (let ((contents (clojure-delete-and-extract-sexp)))
1978
      (backward-up-list)
1979
      (just-one-space 0)
1165
      (save-excursion
1980
      (save-excursion
1166
        (goto-char (point-min))
1981
        (insert contents "\n")
1167
        (when (re-search-forward regexp nil t)
1982
        (clojure--remove-superfluous-parens))
1168
          (match-string-no-properties 4))))))
1983
      (when (looking-at "\\s-*\n")
1169
1984
        (join-line 'following)
1170
(define-obsolete-function-alias 'clojure-find-package 'clojure-find-ns)
1985
        (forward-char 1)
1171
1986
        (put-text-property (point) (1+ (point))
1172
;; Test navigation:
1987
                           'clojure-thread-line-joined t))
1173
(defun clojure-in-tests-p ()
1988
      t)))
1174
  "Check whether the current file is a test file.
1989
1175
1990
(defun clojure--thread-last ()
1176
Two checks are made - whether the namespace of the file has the
1991
  "Thread a nested sexp using ->>."
1177
word test in it and whether the file lives under the test/ directory."
1992
  (forward-sexp 2)
1178
  (or (string-match-p "test\." (clojure-find-ns))
1993
  (down-list -1)
1179
      (string-match-p "/test" (buffer-file-name))))
1994
  (backward-sexp)
1180
1995
  (unless (eq (char-before) ?\()
1181
(defun clojure-underscores-for-hyphens (namespace)
1996
    (let ((contents (clojure-delete-and-extract-sexp)))
1182
  "Replace all hyphens in NAMESPACE with underscores."
1997
      (just-one-space 0)
1183
  (replace-regexp-in-string "-" "_" namespace))
1998
      (backward-up-list)
1184
1999
      (insert contents "\n")
1185
(defun clojure-test-for (namespace)
2000
      (clojure--remove-superfluous-parens)
1186
  "Return the path of the test file for the given NAMESPACE."
2001
      ;; cljr #255 Fix dangling parens
1187
  (let* ((namespace (clojure-underscores-for-hyphens namespace))
2002
      (forward-sexp)
1188
         (segments (split-string namespace "\\.")))
2003
      (when (looking-back "^\\s-*\\()+\\)\\s-*" (line-beginning-position))
1189
    (format "%stest/%s_test.clj"
2004
        (let ((pos (match-beginning 1)))
1190
            (file-name-as-directory
2005
          (put-text-property pos (1+ pos) 'clojure-thread-line-joined t))
1191
             (locate-dominating-file buffer-file-name "src/"))
2006
        (join-line))
1192
            (mapconcat 'identity segments "/"))))
2007
      t)))
1193
2008
1194
(defvar clojure-test-for-fn 'clojure-test-for
2009
(defun clojure--threadable-p ()
1195
  "The function that will return the full path of the Clojure test file for the given namespace.")
2010
  "Return non-nil if a form can be threaded."
1196
2011
  (save-excursion
1197
(defun clojure-jump-to-test ()
2012
    (forward-symbol 1)
1198
  "Jump from implementation file to test."
2013
    (looking-at "[\n\r\t ]*(")))
1199
  (interactive)
2014
1200
  (find-file (funcall clojure-test-for-fn (clojure-find-ns))))
2015
;;;###autoload
1201
2016
(defun clojure-thread ()
1202
(make-obsolete 'clojure-jump-to-test
2017
  "Thread by one more level an existing threading macro."
1203
               "use projectile or toggle.el instead." "2.1.1")
2018
  (interactive)
1204
2019
  (ignore-errors
1205
(defun clojure-jump-between-tests-and-code ()
2020
    (when (looking-at "(")
1206
  "Jump between implementation and related test file."
2021
      (forward-char 1)
1207
  (interactive)
2022
      (forward-sexp 1)))
1208
  (if (clojure-in-tests-p)
2023
  (search-backward-regexp "([^-]*->")
1209
      (clojure-test-jump-to-implementation)
2024
  (down-list)
1210
    (clojure-jump-to-test)))
2025
  (when (clojure--threadable-p)
2026
    (prog1 (cond
2027
            ((looking-at "[^-]*->\\_>")  (clojure--thread-first))
2028
            ((looking-at "[^-]*->>\\_>") (clojure--thread-last)))
2029
      (clojure--fix-sexp-whitespace 'move-out))))
2030
2031
(defun clojure--thread-all (first-or-last-thread but-last)
2032
  "Fully thread the form at point.
2033
2034
FIRST-OR-LAST-THREAD is \"->\" or \"->>\".
2035
2036
When BUT-LAST is non-nil, the last expression is not threaded.
2037
Default value is `clojure-thread-all-but-last'."
2038
  (save-excursion
2039
    (insert-parentheses 1)
2040
    (insert first-or-last-thread))
2041
  (while (save-excursion (clojure-thread)))
2042
  (when (or but-last clojure-thread-all-but-last)
2043
    (clojure-unwind)))
2044
2045
;;;###autoload
2046
(defun clojure-thread-first-all (but-last)
2047
  "Fully thread the form at point using ->.
2048
2049
When BUT-LAST is non-nil, the last expression is not threaded.
2050
Default value is `clojure-thread-all-but-last'."
2051
  (interactive "P")
2052
  (clojure--thread-all "-> " but-last))
2053
2054
;;;###autoload
2055
(defun clojure-thread-last-all (but-last)
2056
  "Fully thread the form at point using ->>.
2057
2058
When BUT-LAST is non-nil, the last expression is not threaded.
2059
Default value is `clojure-thread-all-but-last'."
2060
  (interactive "P")
2061
  (clojure--thread-all "->> " but-last))
2062
2063
;;; Cycling stuff
2064
2065
(defcustom clojure-use-metadata-for-privacy nil
2066
  "If nil, `clojure-cycle-privacy' will use (defn- f []).
2067
If t, it will use (defn ^:private f [])."
2068
  :package-version '(clojure-mode . "5.5.0")
2069
  :safe #'booleanp
2070
  :type 'boolean)
2071
2072
;;;###autoload
2073
(defun clojure-cycle-privacy ()
2074
  "Make public the current private def, or vice-versa.
2075
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy"
2076
  (interactive)
2077
  (save-excursion
2078
    (ignore-errors (forward-char 7))
2079
    (search-backward-regexp "(defn?\\(-\\| ^:private\\)?\\_>")
2080
    (if (match-string 1)
2081
        (replace-match "" nil nil nil 1)
2082
      (goto-char (match-end 0))
2083
      (insert (if (or clojure-use-metadata-for-privacy
2084
                      (equal (match-string 0) "(def"))
2085
                  " ^:private"
2086
                "-")))))
2087
2088
(defun clojure--convert-collection (coll-open coll-close)
2089
  "Convert the collection at (point) by unwrapping it an wrapping it between COLL-OPEN and COLL-CLOSE."
2090
  (save-excursion
2091
    (while (and
2092
            (not (bobp))
2093
            (not (looking-at "(\\|{\\|\\[")))
2094
      (backward-char))
2095
    (when (or (eq ?\# (char-before))
2096
              (eq ?\' (char-before)))
2097
      (delete-char -1))
2098
    (when (and (bobp)
2099
               (not (memq (char-after) '(?\{ ?\( ?\[))))
2100
      (user-error "Beginning of file reached, collection is not found"))
2101
    (insert coll-open (substring (clojure-delete-and-extract-sexp) 1 -1) coll-close)))
2102
2103
;;;###autoload
2104
(defun clojure-convert-collection-to-list ()
2105
  "Convert collection at (point) to list."
2106
  (interactive)
2107
  (clojure--convert-collection "(" ")"))
2108
2109
;;;###autoload
2110
(defun clojure-convert-collection-to-quoted-list ()
2111
  "Convert collection at (point) to quoted list."
2112
  (interactive)
2113
  (clojure--convert-collection "'(" ")"))
2114
2115
;;;###autoload
2116
(defun clojure-convert-collection-to-map ()
2117
  "Convert collection at (point) to map."
2118
  (interactive)
2119
  (clojure--convert-collection "{" "}"))
2120
2121
;;;###autoload
2122
(defun clojure-convert-collection-to-vector ()
2123
  "Convert collection at (point) to vector."
2124
  (interactive)
2125
  (clojure--convert-collection "[" "]"))
2126
2127
;;;###autoload
2128
(defun clojure-convert-collection-to-set ()
2129
  "Convert collection at (point) to set."
2130
  (interactive)
2131
  (clojure--convert-collection "#{" "}"))
2132
2133
(defun clojure--goto-if ()
2134
  "Find the first surrounding if or if-not expression."
2135
  (when (in-string-p)
2136
    (while (or (not (looking-at "("))
2137
               (in-string-p))
2138
      (backward-char)))
2139
  (while (not (looking-at "\\((if \\)\\|\\((if-not \\)"))
2140
    (condition-case nil
2141
        (backward-up-list)
2142
      (scan-error (user-error "No if or if-not found")))))
2143
2144
;;;###autoload
2145
(defun clojure-cycle-if ()
2146
  "Change a surrounding if to if-not, or vice-versa.
2147
2148
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if"
2149
  (interactive)
2150
  (save-excursion
2151
    (clojure--goto-if)
2152
    (cond
2153
     ((looking-at "(if-not")
2154
      (forward-char 3)
2155
      (delete-char 4)
2156
      (forward-sexp 2)
2157
      (transpose-sexps 1))
2158
     ((looking-at "(if")
2159
      (forward-char 3)
2160
      (insert "-not")
2161
      (forward-sexp 2)
2162
      (transpose-sexps 1)))))
2163
2164
;; TODO: Remove code duplication with `clojure--goto-if'.
2165
(defun clojure--goto-when ()
2166
  "Find the first surrounding when or when-not expression."
2167
  (when (in-string-p)
2168
    (while (or (not (looking-at "("))
2169
               (in-string-p))
2170
      (backward-char)))
2171
  (while (not (looking-at "\\((when \\)\\|\\((when-not \\)"))
2172
    (condition-case nil
2173
        (backward-up-list)
2174
      (scan-error (user-error "No when or when-not found")))))
2175
2176
;;;###autoload
2177
(defun clojure-cycle-when ()
2178
  "Change a surrounding when to when-not, or vice-versa."
2179
  (interactive)
2180
  (save-excursion
2181
    (clojure--goto-when)
2182
    (cond
2183
     ((looking-at "(when-not")
2184
      (forward-char 9)
2185
      (delete-char -4))
2186
     ((looking-at "(when")
2187
      (forward-char 5)
2188
      (insert "-not")))))
2189
2190
(defun clojure-cycle-not ()
2191
  "Add or remove a not form around the current form."
2192
  (interactive)
2193
  (save-excursion
2194
    (condition-case nil
2195
        (backward-up-list)
2196
      (scan-error (user-error "`clojure-cycle-not' must be invoked inside a list")))
2197
    (if (looking-back "(not ")
2198
        (progn
2199
          (delete-char -5)
2200
          (forward-sexp)
2201
          (delete-char 1))
2202
      (insert "(not ")
2203
      (forward-sexp)
2204
      (insert ")"))))
2205
2206
;;; let related stuff
2207
2208
(defvar clojure--let-regexp
2209
  "\(\\(when-let\\|if-let\\|let\\)\\(\\s-*\\|\\[\\)"
2210
  "Regexp matching let like expressions, i.e. \"let\", \"when-let\", \"if-let\".
2211
2212
The first match-group is the let expression.
2213
2214
The second match-group is the whitespace or the opening square
2215
bracket if no whitespace between the let expression and the
2216
bracket.")
2217
2218
(defun clojure--goto-let ()
2219
  "Go to the beginning of the nearest let form."
2220
  (when (in-string-p)
2221
    (while (or (not (looking-at "("))
2222
               (in-string-p))
2223
      (backward-char)))
2224
  (ignore-errors
2225
    (while (not (looking-at clojure--let-regexp))
2226
      (backward-up-list)))
2227
  (looking-at clojure--let-regexp))
2228
2229
(defun clojure--inside-let-binding-p ()
2230
  "Return non-nil if point is inside a let binding."
2231
  (ignore-errors
2232
    (save-excursion
2233
      (let ((pos (point)))
2234
        (clojure--goto-let)
2235
        (re-search-forward "\\[")
2236
        (if (< pos (point))
2237
            nil
2238
          (forward-sexp)
2239
          (up-list)
2240
          (< pos (point)))))))
2241
2242
(defun clojure--beginning-of-current-let-binding ()
2243
  "Move before the bound name of the current binding.
2244
Assume that point is in the binding form of a let."
2245
  (let ((current-point (point)))
2246
    (clojure--goto-let)
2247
    (search-forward "[")
2248
    (forward-char)
2249
    (while (> current-point (point))
2250
      (forward-sexp))
2251
    (backward-sexp 2)))
2252
2253
(defun clojure--previous-line ()
2254
  "Keep the column position while go the previous line."
2255
  (let ((col (current-column)))
2256
    (forward-line -1)
2257
    (move-to-column col)))
2258
2259
(defun clojure--prepare-to-insert-new-let-binding ()
2260
  "Move to right place in the let form to insert a new binding and indent."
2261
  (if (clojure--inside-let-binding-p)
2262
      (progn
2263
        (clojure--beginning-of-current-let-binding)
2264
        (newline-and-indent)
2265
        (clojure--previous-line)
2266
        (indent-for-tab-command))
2267
    (clojure--goto-let)
2268
    (search-forward "[")
2269
    (backward-up-list)
2270
    (forward-sexp)
2271
    (down-list -1)
2272
    (backward-char)
2273
    (if (looking-at "\\[\\s-*\\]")
2274
        (forward-char)
2275
      (forward-char)
2276
      (newline-and-indent))))
2277
2278
(defun clojure--sexp-regexp (sexp)
2279
  "Return a regexp for matching SEXP."
2280
  (concat "\\([^[:word:]^-]\\)"
2281
          (mapconcat #'identity (mapcar 'regexp-quote (split-string sexp))
2282
                     "[[:space:]\n\r]+")
2283
          "\\([^[:word:]^-]\\)"))
2284
2285
(defun clojure--replace-sexp-with-binding (bound-name init-expr)
2286
  "Replace a binding with its bound name in the let form.
2287
2288
BOUND-NAME is the name (left-hand side) of a binding.
2289
2290
INIT-EXPR is the value (right-hand side) of a binding."
2291
  (save-excursion
2292
    (while (re-search-forward
2293
            (clojure--sexp-regexp init-expr)
2294
            (clojure--point-after 'clojure--goto-let 'forward-sexp)
2295
            t)
2296
      (replace-match (concat "\\1" bound-name "\\2")))))
2297
2298
(defun clojure--replace-sexps-with-bindings (bindings)
2299
  "Replace bindings with their respective bound names in the let form.
2300
2301
BINDINGS is the list of bound names and init expressions."
2302
  (let ((bound-name (pop bindings))
2303
        (init-expr (pop bindings)))
2304
    (when bound-name
2305
      (clojure--replace-sexp-with-binding bound-name init-expr)
2306
      (clojure--replace-sexps-with-bindings bindings))))
2307
2308
(defun clojure--replace-sexps-with-bindings-and-indent ()
2309
  "Replace sexps with bindings."
2310
  (clojure--replace-sexps-with-bindings
2311
   (clojure--read-let-bindings))
2312
  (clojure-indent-region
2313
   (clojure--point-after 'clojure--goto-let)
2314
   (clojure--point-after 'clojure--goto-let 'forward-sexp)))
2315
2316
(defun clojure--read-let-bindings ()
2317
  "Read the bound-name and init expression pairs in the binding form.
2318
Return a list: odd elements are bound names, even elements init expressions."
2319
  (clojure--goto-let)
2320
  (down-list 2)
2321
  (let* ((start (point))
2322
         (sexp-start start)
2323
         (end (save-excursion
2324
                (backward-char)
2325
                (forward-sexp)
2326
                (down-list -1)
2327
                (point)))
2328
         bindings)
2329
    (while (/= sexp-start end)
2330
      (forward-sexp)
2331
      (push
2332
       (string-trim (buffer-substring-no-properties sexp-start (point)))
2333
       bindings)
2334
      (skip-chars-forward "\r\n\t[:blank:]")
2335
      (setq sexp-start (point)))
2336
    (nreverse bindings)))
2337
2338
(defun clojure--introduce-let-internal (name &optional n)
2339
  "Create a let form, binding the form at point with NAME.
2340
2341
Optional numeric argument N, if non-nil, introduces the let N
2342
lists up."
2343
  (if (numberp n)
2344
      (let ((init-expr-sexp (clojure-delete-and-extract-sexp)))
2345
        (insert name)
2346
        (ignore-errors (backward-up-list n))
2347
        (insert "(let" (clojure-delete-and-extract-sexp) ")")
2348
        (backward-sexp)
2349
        (down-list)
2350
        (forward-sexp)
2351
        (insert " [" name " " init-expr-sexp "]\n")
2352
        (clojure--replace-sexps-with-bindings-and-indent))
2353
    (insert "[ " (clojure-delete-and-extract-sexp) "]")
2354
    (backward-sexp)
2355
    (insert "(let " (clojure-delete-and-extract-sexp) ")")
2356
    (backward-sexp)
2357
    (down-list 2)
2358
    (insert name)
2359
    (forward-sexp)
2360
    (up-list)
2361
    (newline-and-indent)
2362
    (insert name)))
2363
2364
(defun clojure--move-to-let-internal (name)
2365
  "Bind the form at point to NAME in the nearest let."
2366
  (if (not (save-excursion (clojure--goto-let)))
2367
      (clojure--introduce-let-internal name)
2368
    (let ((contents (clojure-delete-and-extract-sexp)))
2369
      (insert name)
2370
      (clojure--prepare-to-insert-new-let-binding)
2371
      (insert contents)
2372
      (backward-sexp)
2373
      (insert " ")
2374
      (backward-char)
2375
      (insert name)
2376
      (clojure--replace-sexps-with-bindings-and-indent))))
2377
2378
(defun clojure--let-backward-slurp-sexp-internal ()
2379
  "Slurp the s-expression before the let form into the let form."
2380
  (clojure--goto-let)
2381
  (backward-sexp)
2382
  (let ((sexp (string-trim (clojure-delete-and-extract-sexp))))
2383
    (delete-blank-lines)
2384
    (down-list)
2385
    (forward-sexp 2)
2386
    (newline-and-indent)
2387
    (insert sexp)
2388
    (clojure--replace-sexps-with-bindings-and-indent)))
2389
2390
;;;###autoload
2391
(defun clojure-let-backward-slurp-sexp (&optional n)
2392
  "Slurp the s-expression before the let form into the let form.
2393
With a numberic prefix argument slurp the previous N s-expression into the let form."
2394
  (interactive "p")
2395
  (unless n (setq n 1))
2396
  (dotimes (k n)
2397
    (save-excursion (clojure--let-backward-slurp-sexp-internal))))
2398
2399
(defun clojure--let-forward-slurp-sexp-internal ()
2400
  "Slurp the next s-expression after the let form into the let form."
2401
  (clojure--goto-let)
2402
  (forward-sexp)
2403
  (let ((sexp (string-trim (clojure-delete-and-extract-sexp))))
2404
    (down-list -1)
2405
    (newline-and-indent)
2406
    (insert sexp)
2407
    (clojure--replace-sexps-with-bindings-and-indent)))
2408
2409
;;;###autoload
2410
(defun clojure-let-forward-slurp-sexp (&optional n)
2411
  "Slurp the next s-expression after the let form into the let form.
2412
With a numeric prefix argument slurp the next N s-expressions into the let form."
2413
  (interactive "p")
2414
  (unless n (setq n 1))
2415
  (dotimes (k n)
2416
    (save-excursion (clojure--let-forward-slurp-sexp-internal))))
2417
2418
;;;###autoload
2419
(defun clojure-introduce-let (&optional n)
2420
  "Create a let form, binding the form at point.
2421
With a numeric prefix argument the let is introduced N lists up."
2422
  (interactive "P")
2423
  (clojure--introduce-let-internal (read-from-minibuffer "Name of bound symbol: ") n))
2424
2425
;;;###autoload
2426
(defun clojure-move-to-let ()
2427
  "Move the form at point to a binding in the nearest let."
2428
  (interactive)
2429
  (clojure--move-to-let-internal (read-from-minibuffer "Name of bound symbol: ")))
2430
2431
2432
;;; ClojureScript
2433
(defconst clojurescript-font-lock-keywords
2434
  (eval-when-compile
2435
    `(;; ClojureScript built-ins
2436
      (,(concat "(\\(?:\.*/\\)?"
2437
                (regexp-opt '("js-obj" "js-delete" "clj->js" "js->clj"))
2438
                "\\>")
2439
       0 font-lock-builtin-face)))
2440
  "Additional font-locking for `clojurescript-mode'.")
2441
2442
;;;###autoload
2443
(define-derived-mode clojurescript-mode clojure-mode "ClojureScript"
2444
  "Major mode for editing ClojureScript code.
2445
2446
\\{clojurescript-mode-map}"
2447
  (font-lock-add-keywords nil clojurescript-font-lock-keywords))
2448
2449
;;;###autoload
2450
(define-derived-mode clojurec-mode clojure-mode "ClojureC"
2451
  "Major mode for editing ClojureC code.
2452
2453
\\{clojurec-mode-map}")
2454
2455
(defconst clojurex-font-lock-keywords
2456
  ;; cljx annotations (#+clj and #+cljs)
2457
  '(("#\\+cljs?\\>" 0 font-lock-preprocessor-face))
2458
  "Additional font-locking for `clojurex-mode'.")
2459
2460
;;;###autoload
2461
(define-derived-mode clojurex-mode clojure-mode "ClojureX"
2462
  "Major mode for editing ClojureX code.
2463
2464
\\{clojurex-mode-map}"
2465
  (font-lock-add-keywords nil clojurex-font-lock-keywords))
1211
2466
1212
;;;###autoload
2467
;;;###autoload
1213
(progn
2468
(progn
1214
  (add-to-list 'auto-mode-alist '("\\.clj[sx]?\\'" . clojure-mode))
2469
  (add-to-list 'auto-mode-alist
1215
  (add-to-list 'auto-mode-alist '("\\.dtm\\'" . clojure-mode))
2470
               '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode))
1216
  (add-to-list 'auto-mode-alist '("\\.edn\\'" . clojure-mode))
2471
  (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode))
1217
  (add-to-list 'interpreter-mode-alist '("jark" . clojure-mode))
2472
  (add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode))
1218
  (add-to-list 'interpreter-mode-alist '("cake" . clojure-mode)))
2473
  (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode))
2474
  ;; boot build scripts are Clojure source files
2475
  (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode)))
1219
2476
1220
(provide 'clojure-mode)
2477
(provide 'clojure-mode)
1221
2478
1222
;; Local Variables:
2479
;; Local Variables:
1223
;; byte-compile-warnings: (not cl-functions)
2480
;; coding: utf-8
1224
;; End:
2481
;; End:
1225
2482
1226
;;; clojure-mode.el ends here
2483
;;; clojure-mode.el ends here
(-)clojure-mode-5.6.1/test.clj (-38 / +21 lines)
Lines 1-7 Link Here
1
;;; font locking
1
(ns clojure-mode.test
2
(ns clojure-mode.demo
2
  (:use [clojure.test]))
3
  (:require [clojure.something]
3
4
            [something.s]))
4
(deftest test-str
5
  (is (= "o hai" (str "o" "hai"))))
6
7
(deftest test-errs
8
  (is (({} :hi)))
9
  (is (str "This one doesn't actually error."))
10
  (is (= 0 (/ 9 0))))
11
12
(deftest test-bad-math
13
  (is (= 0 (* 8 2)))
14
  (is (= 5 (+ 2 2))))
15
16
(deftest test-something-that-actually-works
17
  (is (= 1 1)))
18
19
;; For debugging
20
;; (map #(cons (str (:name (meta %))) (:status (meta %))) (vals (ns-interns *ns*)))
21
;; (insert (pp the-result))
5
22
6
(comment ;; for indentation
23
(comment ;; for indentation
7
  (with-hi heya
24
  (with-hi heya
Lines 16-55 Link Here
16
  (clo/defguppy gurgle
33
  (clo/defguppy gurgle
17
    minnow))
34
    minnow))
18
35
19
;; character literals
20
[\a \newline \u0032 \/ \+ \,, \;]
21
22
;; namespaced/static calls/references
23
(core.foo-baz/bar)
24
@foo-bar/bar
25
(FooBar/bar)
26
(some.package.FooBar/baz)
27
28
;; cljx
29
(defn x-to-string
30
  [x]
31
  (let [buf #+clj (StringBuilder.) #+cljs (gstring/StringBuffer.)]
32
    (.append buf "x is: ")
33
    (.append buf (str x))))
34
35
;; metadata doesn't break docstrings
36
(defn max
37
  "Returns the greatest of the nums."
38
  {:added "1.0"
39
   :inline-arities >1?
40
   :inline (nary-inline 'max)}
41
  ([x] x)
42
  ([x y] (. clojure.lang.Numbers (max x y)))
43
  ([x y & more]
44
     (reduce1 max (max x y) more)))
45
46
(defn ^String reverse
47
  "Returns s with its characters reversed."
48
  {:added "1.2"}
49
  [^CharSequence s]
50
  (.toString (.reverse (StringBuilder. s))))
51
52
;; useful for testing docstring filling
53
(defn say-hello
36
(defn say-hello
54
  "This is a long doc string to test clojure-fill-docstring. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus sed nunc luctus leo ultricies semper. Nullam id tempor mi. Cras adipiscing scelerisque purus, at semper magna tincidunt ut. Sed eget dolor vitae enim feugiat porttitor. Etiam vulputate pulvinar lacinia. Nam vitae nisl sit amet libero pulvinar pretium nec a dui. Ut luctus elit eu nulla posuere nec feugiat ipsum vehicula. Quisque eu pulvinar neque. Fusce fermentum adipiscing mauris, sit amet accumsan ante dignissim ac. Pellentesque molestie mollis condimentum.
37
  "This is a long doc string to test clojure-fill-docstring. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus sed nunc luctus leo ultricies semper. Nullam id tempor mi. Cras adipiscing scelerisque purus, at semper magna tincidunt ut. Sed eget dolor vitae enim feugiat porttitor. Etiam vulputate pulvinar lacinia. Nam vitae nisl sit amet libero pulvinar pretium nec a dui. Ut luctus elit eu nulla posuere nec feugiat ipsum vehicula. Quisque eu pulvinar neque. Fusce fermentum adipiscing mauris, sit amet accumsan ante dignissim ac. Pellentesque molestie mollis condimentum.
55
38

Return to bug 221818