diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/clojure-mode-20180709.648/clojure-mode.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/clojure-mode-20180709.648/clojure-mode.el | 2596 |
1 files changed, 2596 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/clojure-mode-20180709.648/clojure-mode.el b/configs/shared/emacs/.emacs.d/elpa/clojure-mode-20180709.648/clojure-mode.el new file mode 100644 index 000000000000..a98ba5fc5e7e --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/clojure-mode-20180709.648/clojure-mode.el @@ -0,0 +1,2596 @@ +;;; clojure-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*- + +;; Copyright © 2007-2018 Jeffrey Chu, Lennart Staflin, Phil Hagelberg +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba +;; +;; Authors: Jeffrey Chu <jochu0@gmail.com> +;; Lennart Staflin <lenst@lysator.liu.se> +;; Phil Hagelberg <technomancy@gmail.com> +;; Bozhidar Batsov <bozhidar@batsov.com> +;; Artur Malabarba <bruce.connor.am@gmail.com> +;; URL: http://github.com/clojure-emacs/clojure-mode +;; Package-Version: 20180709.648 +;; Keywords: languages clojure clojurescript lisp +;; Version: 5.9.0-snapshot +;; Package-Requires: ((emacs "25.1")) + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides font-lock, indentation, navigation and basic refactoring for the +;; Clojure programming language (http://clojure.org). + +;; Using clojure-mode with paredit or smartparens is highly recommended. + +;; Here are some example configurations: + +;; ;; require or autoload paredit-mode +;; (add-hook 'clojure-mode-hook #'paredit-mode) + +;; ;; require or autoload smartparens +;; (add-hook 'clojure-mode-hook #'smartparens-strict-mode) + +;; See inf-clojure (http://github.com/clojure-emacs/inf-clojure) for +;; basic interaction with Clojure subprocesses. + +;; See CIDER (http://github.com/clojure-emacs/cider) for +;; better interaction with subprocesses via nREPL. + +;;; License: + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Code: + + +(eval-when-compile + (defvar calculate-lisp-indent-last-sexp) + (defvar font-lock-beg) + (defvar font-lock-end) + (defvar paredit-space-for-delimiter-predicates) + (defvar paredit-version) + (defvar paredit-mode)) + +(require 'cl-lib) +(require 'imenu) +(require 'newcomment) +(require 'align) +(require 'subr-x) + +(declare-function lisp-fill-paragraph "lisp-mode" (&optional justify)) + +(defgroup clojure nil + "Major mode for editing Clojure code." + :prefix "clojure-" + :group 'languages + :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/clojure-mode") + :link '(emacs-commentary-link :tag "Commentary" "clojure-mode")) + +(defconst clojure-mode-version "5.9.0-snapshot" + "The current version of `clojure-mode'.") + +(defface clojure-keyword-face + '((t (:inherit font-lock-constant-face))) + "Face used to font-lock Clojure keywords (:something)." + :package-version '(clojure-mode . "3.0.0")) + +(defface clojure-character-face + '((t (:inherit font-lock-string-face))) + "Face used to font-lock Clojure character literals." + :package-version '(clojure-mode . "3.0.0")) + +(defcustom clojure-indent-style :always-align + "Indentation style to use for function forms and macro forms. +There are two cases of interest configured by this variable. + +- Case (A) is when at least one function argument is on the same + line as the function name. +- Case (B) is the opposite (no arguments are on the same line as + the function name). Note that the body of macros is not + affected by this variable, it is always indented by + `lisp-body-indent' (default 2) spaces. + +Note that this variable configures the indentation of function +forms (and function-like macros), it does not affect macros that +already use special indentation rules. + +The possible values for this variable are keywords indicating how +to indent function forms. + + `:always-align' - Follow the same rules as `lisp-mode'. All + args are vertically aligned with the first arg in case (A), + and vertically aligned with the function name in case (B). + For instance: + (reduce merge + some-coll) + (reduce + merge + some-coll) + + `:always-indent' - All args are indented like a macro body. + (reduce merge + some-coll) + (reduce + merge + some-coll) + + `:align-arguments' - Case (A) is indented like `lisp', and + case (B) is indented like a macro body. + (reduce merge + some-coll) + (reduce + merge + some-coll)" + :safe #'keywordp + :type '(choice (const :tag "Same as `lisp-mode'" :always-align) + (const :tag "Indent like a macro body" :always-indent) + (const :tag "Indent like a macro body unless first arg is on the same line" + :align-arguments)) + :package-version '(clojure-mode . "5.2.0")) + +(define-obsolete-variable-alias 'clojure-defun-style-default-indent + 'clojure-indent-style "5.2.0") + +(defcustom clojure-use-backtracking-indent t + "When non-nil, enable context sensitive indentation." + :type 'boolean + :safe 'booleanp) + +(defcustom clojure-max-backtracking 3 + "Maximum amount to backtrack up a list to check for context." + :type 'integer + :safe 'integerp) + +(defcustom clojure-docstring-fill-column fill-column + "Value of `fill-column' to use when filling a docstring." + :type 'integer + :safe 'integerp) + +(defcustom clojure-docstring-fill-prefix-width 2 + "Width of `fill-prefix' when filling a docstring. +The default value conforms with the de facto convention for +Clojure docstrings, aligning the second line with the opening +double quotes on the third column." + :type 'integer + :safe 'integerp) + +(defcustom clojure-omit-space-between-tag-and-delimiters '(?\[ ?\{ ?\() + "Allowed opening delimiter characters after a reader literal tag. +For example, \[ is allowed in :db/id[:db.part/user]." + :type '(set (const :tag "[" ?\[) + (const :tag "{" ?\{) + (const :tag "(" ?\() + (const :tag "\"" ?\")) + :safe (lambda (value) + (and (listp value) + (cl-every 'characterp value)))) + +(defcustom clojure-build-tool-files + '("project.clj" ; Leiningen + "build.boot" ; Boot + "build.gradle" ; Gradle + "deps.edn" ; Clojure CLI (a.k.a. tools.deps) + "shadow-cljs.edn" ; shadow-cljs + ) + "A list of files, which identify a Clojure project's root. +Out-of-the box `clojure-mode' understands lein, boot, gradle, + shadow-cljs and tools.deps." + :type '(repeat string) + :package-version '(clojure-mode . "5.0.0") + :safe (lambda (value) + (and (listp value) + (cl-every 'stringp value)))) + +(defcustom clojure-project-root-function #'clojure-project-root-path + "Function to locate clojure project root directory." + :type 'function + :risky t + :package-version '(clojure-mode . "5.7.0")) + +(defcustom clojure-refactor-map-prefix (kbd "C-c C-r") + "Clojure refactor keymap prefix." + :type 'string + :package-version '(clojure-mode . "5.6.0")) + +(defvar clojure-refactor-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-t") #'clojure-thread) + (define-key map (kbd "t") #'clojure-thread) + (define-key map (kbd "C-u") #'clojure-unwind) + (define-key map (kbd "u") #'clojure-unwind) + (define-key map (kbd "C-f") #'clojure-thread-first-all) + (define-key map (kbd "f") #'clojure-thread-first-all) + (define-key map (kbd "C-l") #'clojure-thread-last-all) + (define-key map (kbd "l") #'clojure-thread-last-all) + (define-key map (kbd "C-a") #'clojure-unwind-all) + (define-key map (kbd "a") #'clojure-unwind-all) + (define-key map (kbd "C-p") #'clojure-cycle-privacy) + (define-key map (kbd "p") #'clojure-cycle-privacy) + (define-key map (kbd "C-(") #'clojure-convert-collection-to-list) + (define-key map (kbd "(") #'clojure-convert-collection-to-list) + (define-key map (kbd "C-'") #'clojure-convert-collection-to-quoted-list) + (define-key map (kbd "'") #'clojure-convert-collection-to-quoted-list) + (define-key map (kbd "C-{") #'clojure-convert-collection-to-map) + (define-key map (kbd "{") #'clojure-convert-collection-to-map) + (define-key map (kbd "C-[") #'clojure-convert-collection-to-vector) + (define-key map (kbd "[") #'clojure-convert-collection-to-vector) + (define-key map (kbd "C-#") #'clojure-convert-collection-to-set) + (define-key map (kbd "#") #'clojure-convert-collection-to-set) + (define-key map (kbd "C-i") #'clojure-cycle-if) + (define-key map (kbd "i") #'clojure-cycle-if) + (define-key map (kbd "C-w") #'clojure-cycle-when) + (define-key map (kbd "w") #'clojure-cycle-when) + (define-key map (kbd "C-o") #'clojure-cycle-not) + (define-key map (kbd "o") #'clojure-cycle-not) + (define-key map (kbd "n i") #'clojure-insert-ns-form) + (define-key map (kbd "n h") #'clojure-insert-ns-form-at-point) + (define-key map (kbd "n u") #'clojure-update-ns) + (define-key map (kbd "n s") #'clojure-sort-ns) + (define-key map (kbd "s i") #'clojure-introduce-let) + (define-key map (kbd "s m") #'clojure-move-to-let) + (define-key map (kbd "s f") #'clojure-let-forward-slurp-sexp) + (define-key map (kbd "s b") #'clojure-let-backward-slurp-sexp) + map) + "Keymap for Clojure refactoring commands.") +(fset 'clojure-refactor-map clojure-refactor-map) + +(defvar clojure-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map prog-mode-map) + (define-key map (kbd "C-:") #'clojure-toggle-keyword-string) + (define-key map (kbd "C-c SPC") #'clojure-align) + (define-key map clojure-refactor-map-prefix 'clojure-refactor-map) + (easy-menu-define clojure-mode-menu map "Clojure Mode Menu" + '("Clojure" + ["Toggle between string & keyword" clojure-toggle-keyword-string] + ["Align expression" clojure-align] + ["Cycle privacy" clojure-cycle-privacy] + ["Cycle if, if-not" clojure-cycle-if] + ["Cycle when, when-not" clojure-cycle-when] + ["Cycle not" clojure-cycle-not] + ("ns forms" + ["Insert ns form at the top" clojure-insert-ns-form] + ["Insert ns form here" clojure-insert-ns-form-at-point] + ["Update ns form" clojure-update-ns] + ["Sort ns form" clojure-sort-ns]) + ("Convert collection" + ["Convert to list" clojure-convert-collection-to-list] + ["Convert to quoted list" clojure-convert-collection-to-quoted-list] + ["Convert to map" clojure-convert-collection-to-map] + ["Convert to vector" clojure-convert-collection-to-vector] + ["Convert to set" clojure-convert-collection-to-set]) + ("Refactor -> and ->>" + ["Thread once more" clojure-thread] + ["Fully thread a form with ->" clojure-thread-first-all] + ["Fully thread a form with ->>" clojure-thread-last-all] + "--" + ["Unwind once" clojure-unwind] + ["Fully unwind a threading macro" clojure-unwind-all]) + ("Let expression" + ["Introduce let" clojure-introduce-let] + ["Move to let" clojure-move-to-let] + ["Forward slurp form into let" clojure-let-forward-slurp-sexp] + ["Backward slurp form into let" clojure-let-backward-slurp-sexp]) + ("Documentation" + ["View a Clojure guide" clojure-view-guide] + ["View a Clojure reference section" clojure-view-reference-section] + ["View the Clojure cheatsheet" clojure-view-cheatsheet] + ["View the Clojure Grimoire" clojure-view-grimoire] + ["View the Clojure style guide" clojure-view-style-guide]) + "--" + ["Report a clojure-mode bug" clojure-mode-report-bug] + ["Clojure-mode version" clojure-mode-display-version])) + map) + "Keymap for Clojure mode.") + +(defvar clojure-mode-syntax-table + (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + (modify-syntax-entry ?? "_ p" table) ; ? is a prefix outside symbols + (modify-syntax-entry ?# "_ p" table) ; # is allowed inside keywords (#399) + (modify-syntax-entry ?~ "'" table) + (modify-syntax-entry ?^ "'" table) + (modify-syntax-entry ?@ "'" table) + table) + "Syntax table for Clojure mode. +Inherits from `emacs-lisp-mode-syntax-table'.") + +(defconst clojure--prettify-symbols-alist + '(("fn" . ?λ))) + +(defvar-local clojure-expected-ns-function nil + "The function used to determine the expected namespace of a file. +`clojure-mode' ships a basic function named `clojure-expected-ns' +that does basic heuristics to figure this out. +CIDER provides a more complex version which does classpath analysis.") + +(defun clojure-mode-display-version () + "Display the current `clojure-mode-version' in the minibuffer." + (interactive) + (message "clojure-mode (version %s)" clojure-mode-version)) + +(defconst clojure-mode-report-bug-url "https://github.com/clojure-emacs/clojure-mode/issues/new" + "The URL to report a `clojure-mode' issue.") + +(defun clojure-mode-report-bug () + "Report a bug in your default browser." + (interactive) + (browse-url clojure-mode-report-bug-url)) + +(defconst clojure-guides-base-url "https://clojure.org/guides/" + "The base URL for official Clojure guides.") + +(defconst clojure-guides '(("Getting Started" . "getting_started") + ("FAQ" . "faq") + ("spec" . "spec") + ("Destructuring" . "destructuring") + ("Threading Macros" . "threading_macros") + ("Comparators" . "comparators") + ("Reader Conditionals" . "reader_conditionals")) + "A list of all official Clojure guides.") + +(defun clojure-view-guide () + "Open a Clojure guide in your default browser. + +The command will prompt you to select one of the available guides." + (interactive) + (let ((guide (completing-read "Select a guide: " (mapcar #'car clojure-guides)))) + (when guide + (let ((guide-url (concat clojure-guides-base-url (cdr (assoc guide clojure-guides))))) + (browse-url guide-url))))) + +(defconst clojure-reference-base-url "https://clojure.org/reference/" + "The base URL for the official Clojure reference.") + +(defconst clojure-reference-sections '(("The Reader" . "reader") + ("The REPL and main" . "repl_and_main") + ("Evaluation" . "evaluation") + ("Special Forms" . "special_forms") + ("Macros" . "macros") + ("Other Functions" . "other_functions") + ("Data Structures" . "data_structures") + ("Datatypes" . "datatypes") + ("Sequences" . "sequences") + ("Transients" . "transients") + ("Transducers" . "transducers") + ("Multimethods and Hierarchies" . "multimethods") + ("Protocols" . "protocols") + ("Metadata" . "metadata") + ("Namespaces" . "namespaces") + ("Libs" . "libs") + ("Vars and Environments" . "vars") + ("Refs and Transactions" . "refs") + ("Agents" . "agents") + ("Atoms" . "atoms") + ("Reducers" . "reducers") + ("Java Interop" . "java_interop") + ("Compilation and Class Generation" . "compilation") + ("Other Libraries" . "other_libraries") + ("Differences with Lisps" . "lisps"))) + +(defun clojure-view-reference-section () + "Open a Clojure reference section in your default browser. + +The command will prompt you to select one of the available sections." + (interactive) + (let ((section (completing-read "Select a reference section: " (mapcar #'car clojure-reference-sections)))) + (when section + (let ((section-url (concat clojure-reference-base-url (cdr (assoc section clojure-reference-sections))))) + (browse-url section-url))))) + +(defconst clojure-cheatsheet-url "http://clojure.org/api/cheatsheet" + "The URL of the official Clojure cheatsheet.") + +(defun clojure-view-cheatsheet () + "Open the Clojure cheatsheet in your default browser." + (interactive) + (browse-url clojure-cheatsheet-url)) + +(defconst clojure-grimoire-url "https://www.conj.io/" + "The URL of the Grimoire community documentation site.") + +(defun clojure-view-grimoire () + "Open the Clojure Grimoire in your default browser." + (interactive) + (browse-url clojure-grimoire-url)) + +(defconst clojure-style-guide-url "https://github.com/bbatsov/clojure-style-guide" + "The URL of the Clojure style guide.") + +(defun clojure-view-style-guide () + "Open the Clojure style guide in your default browser." + (interactive) + (browse-url clojure-style-guide-url)) + +(defun clojure-space-for-delimiter-p (endp delim) + "Prevent paredit from inserting useless spaces. +See `paredit-space-for-delimiter-predicates' for the meaning of +ENDP and DELIM." + (or endp + (not (memq delim '(?\" ?{ ?\( ))) + (not (or (derived-mode-p 'clojure-mode) + (derived-mode-p 'cider-repl-mode))) + (save-excursion + (backward-char) + (cond ((eq (char-after) ?#) + (and (not (bobp)) + (or (char-equal ?w (char-syntax (char-before))) + (char-equal ?_ (char-syntax (char-before)))))) + ((and (eq delim ?\() + (eq (char-after) ??) + (eq (char-before) ?#)) + nil) + (t))))) + +(defconst clojure--collection-tag-regexp "#\\(::[a-zA-Z0-9._-]*\\|:?\\([a-zA-Z0-9._-]+/\\)?[a-zA-Z0-9._-]+\\)" + "Collection reader macro tag regexp. +It is intended to check for allowed strings that can come before a +collection literal (e.g. '[]' or '{}'), as reader macro tags. +This includes #fully.qualified/my-ns[:kw val] and #::my-ns{:kw +val} as of Clojure 1.9.") + +(defun clojure-no-space-after-tag (endp delimiter) + "Prevent inserting a space after a reader-literal tag. + +When a reader-literal tag is followed be an opening delimiter +listed in `clojure-omit-space-between-tag-and-delimiters', this +function returns t. + +This allows you to write things like #db/id[:db.part/user] +and #::my-ns{:some \"map\"} without inserting a space between +the tag and the opening bracket. + +See `paredit-space-for-delimiter-predicates' for the meaning of +ENDP and DELIMITER." + (if endp + t + (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters)) + (save-excursion + (let ((orig-point (point))) + (not (and (re-search-backward + clojure--collection-tag-regexp + (line-beginning-position) + t) + (= orig-point (match-end 0))))))))) + +(declare-function paredit-open-curly "ext:paredit") +(declare-function paredit-close-curly "ext:paredit") +(declare-function paredit-convolute-sexp "ext:paredit") + +(defun clojure--replace-let-bindings-and-indent (orig-fun &rest args) + "Advise ORIG-FUN to replace let bindings. + +Sexps are replace by their bound name if a let form was +convoluted. + +ORIG-FUN should be `paredit-convolute-sexp'. + +ARGS are passed to ORIG-FUN, as with all advice." + (save-excursion + (backward-sexp) + (when (looking-back clojure--let-regexp) + (clojure--replace-sexps-with-bindings-and-indent)))) + +(defun clojure-paredit-setup (&optional keymap) + "Make \"paredit-mode\" play nice with `clojure-mode'. + +If an optional KEYMAP is passed the changes are applied to it, +instead of to `clojure-mode-map'. +Also advice `paredit-convolute-sexp' when used on a let form as drop in +replacement for `cljr-expand-let`." + (when (>= paredit-version 21) + (let ((keymap (or keymap clojure-mode-map))) + (define-key keymap "{" #'paredit-open-curly) + (define-key keymap "}" #'paredit-close-curly)) + (add-to-list 'paredit-space-for-delimiter-predicates + #'clojure-space-for-delimiter-p) + (add-to-list 'paredit-space-for-delimiter-predicates + #'clojure-no-space-after-tag) + (advice-add 'paredit-convolute-sexp :after #'clojure--replace-let-bindings-and-indent))) + +(defun clojure-mode-variables () + "Set up initial buffer-local variables for Clojure mode." + (add-to-list 'imenu-generic-expression '(nil clojure-match-next-def 0)) + (setq-local indent-tabs-mode nil) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\)\\|(") + (setq-local outline-level 'lisp-outline-level) + (setq-local comment-start ";") + (setq-local comment-start-skip ";+ *") + (setq-local comment-add 1) ; default to `;;' in comment-region + (setq-local comment-column 40) + (setq-local comment-use-syntax t) + (setq-local multibyte-syntax-as-symbol t) + (setq-local electric-pair-skip-whitespace 'chomp) + (setq-local electric-pair-open-newline-between-pairs nil) + (setq-local fill-paragraph-function #'clojure-fill-paragraph) + (setq-local adaptive-fill-function #'clojure-adaptive-fill-function) + (setq-local normal-auto-fill-function #'clojure-auto-fill-function) + (setq-local comment-start-skip + "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") + (setq-local indent-line-function #'clojure-indent-line) + (setq-local indent-region-function #'clojure-indent-region) + (setq-local lisp-indent-function #'clojure-indent-function) + (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt) + (setq-local clojure-expected-ns-function #'clojure-expected-ns) + (setq-local parse-sexp-ignore-comments t) + (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) + (setq-local open-paren-in-column-0-is-defun-start nil)) + +(defsubst clojure-in-docstring-p () + "Check whether point is in a docstring." + (let ((ppss (syntax-ppss))) + ;; are we in a string? + (when (nth 3 ppss) + ;; check font lock at the start of the string + (eq (get-text-property (nth 8 ppss) 'face) + 'font-lock-doc-face)))) + +;;;###autoload +(define-derived-mode clojure-mode prog-mode "Clojure" + "Major mode for editing Clojure code. + +\\{clojure-mode-map}" + (clojure-mode-variables) + (clojure-font-lock-setup) + (add-hook 'paredit-mode-hook #'clojure-paredit-setup) + ;; `electric-layout-post-self-insert-function' prevents indentation in strings + ;; and comments, force indentation in docstrings: + (add-hook 'electric-indent-functions + (lambda (_char) (if (clojure-in-docstring-p) 'do-indent))) + ;; integration with project.el + (add-hook 'project-find-functions #'clojure-current-project)) + +(defcustom clojure-verify-major-mode t + "If non-nil, warn when activating the wrong `major-mode'." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-mode "5.3.0")) + +(defun clojure--check-wrong-major-mode () + "Check if the current `major-mode' matches the file extension. + +If it doesn't, issue a warning if `clojure-verify-major-mode' is +non-nil." + (when (and clojure-verify-major-mode + (stringp (buffer-file-name))) + (let* ((case-fold-search t) + (problem (cond ((and (string-match "\\.clj\\'" (buffer-file-name)) + (not (eq major-mode 'clojure-mode))) + 'clojure-mode) + ((and (string-match "\\.cljs\\'" (buffer-file-name)) + (not (eq major-mode 'clojurescript-mode))) + 'clojurescript-mode) + ((and (string-match "\\.cljc\\'" (buffer-file-name)) + (not (eq major-mode 'clojurec-mode))) + 'clojurec-mode)))) + (when problem + (message "[WARNING] %s activated `%s' instead of `%s' in this buffer. +This could cause problems. +\(See `clojure-verify-major-mode' to disable this message.)" + (if (eq major-mode real-this-command) + "You have" + "Something in your configuration") + major-mode + problem))))) + +(add-hook 'clojure-mode-hook #'clojure--check-wrong-major-mode) + +(defsubst clojure-docstring-fill-prefix () + "The prefix string used by `clojure-fill-paragraph'. +It is simply `clojure-docstring-fill-prefix-width' number of spaces." + (make-string clojure-docstring-fill-prefix-width ? )) + +(defun clojure-adaptive-fill-function () + "Clojure adaptive fill function. +This only takes care of filling docstring correctly." + (when (clojure-in-docstring-p) + (clojure-docstring-fill-prefix))) + +(defun clojure-fill-paragraph (&optional justify) + "Like `fill-paragraph', but can handle Clojure docstrings. +If JUSTIFY is non-nil, justify as well as fill the paragraph." + (if (clojure-in-docstring-p) + (let ((paragraph-start + (concat paragraph-start + "\\|\\s-*\\([(:\"[]\\|~@\\|`(\\|#'(\\)")) + (paragraph-separate + (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) + (fill-column (or clojure-docstring-fill-column fill-column)) + (fill-prefix (clojure-docstring-fill-prefix))) + ;; we are in a string and string start pos (8th element) is non-nil + (let* ((beg-doc (nth 8 (syntax-ppss))) + (end-doc (save-excursion + (goto-char beg-doc) + (or (ignore-errors (forward-sexp) (point)) + (point-max))))) + (save-restriction + (narrow-to-region beg-doc end-doc) + (fill-paragraph justify)))) + (let ((paragraph-start (concat paragraph-start + "\\|\\s-*\\([(:\"[]\\|`(\\|#'(\\)")) + (paragraph-separate + (concat paragraph-separate "\\|\\s-*\".*[,\\.[]$"))) + (or (fill-comment-paragraph justify) + (fill-paragraph justify)) + ;; Always return `t' + t))) + +(defun clojure-auto-fill-function () + "Clojure auto-fill function." + ;; Check if auto-filling is meaningful. + (let ((fc (current-fill-column))) + (when (and fc (> (current-column) fc)) + (let ((fill-column (if (clojure-in-docstring-p) + clojure-docstring-fill-column + fill-column)) + (fill-prefix (clojure-adaptive-fill-function))) + (do-auto-fill))))) + + +;;; #_ comments font-locking +;; Code heavily borrowed from Slime. +;; https://github.com/slime/slime/blob/master/contrib/slime-fontifying-fu.el#L186 +(defvar clojure--comment-macro-regexp + (rx "#_" (* " ") (group-n 1 (not (any " ")))) + "Regexp matching the start of a comment sexp. +The beginning of match-group 1 should be before the sexp to be +marked as a comment. The end of sexp is found with +`clojure-forward-logical-sexp'.") + +(defvar clojure--reader-and-comment-regexp + "#_ *\\(?1:[^ ]\\)\\|\\(?1:(comment\\_>\\)" + "Regexp matching both `#_' macro and a comment sexp." ) + +(defcustom clojure-comment-regexp clojure--comment-macro-regexp + "Comment mode. + +The possible values for this variable are keywords indicating +what is considered a comment (affecting font locking). + + - Reader macro `#_' only - the default + - Reader macro `#_' and `(comment)'" + :type '(choice (const :tag "Reader macro `#_' and `(comment)'" clojure--reader-and-comment-regexp) + (other :tag "Reader macro `#_' only" clojure--comment-macro-regexp)) + :package-version '(clojure-mode . "5.7.0")) + +(defun clojure--search-comment-macro-internal (limit) + "Search for a comment forward stopping at LIMIT." + (when (search-forward-regexp clojure-comment-regexp limit t) + (let* ((md (match-data)) + (start (match-beginning 1)) + (state (syntax-ppss start))) + ;; inside string or comment? + (if (or (nth 3 state) + (nth 4 state)) + (clojure--search-comment-macro-internal limit) + (goto-char start) + (clojure-forward-logical-sexp 1) + ;; Data for (match-end 1). + (setf (elt md 3) (point)) + (set-match-data md) + t)))) + +(defun clojure--search-comment-macro (limit) + "Find comment macros and set the match data. +Search from point up to LIMIT. The region that should be +considered a comment is between `(match-beginning 1)' +and `(match-end 1)'." + (let ((result 'retry)) + (while (and (eq result 'retry) (<= (point) limit)) + (condition-case nil + (setq result (clojure--search-comment-macro-internal limit)) + (end-of-file (setq result nil)) + (scan-error (setq result 'retry)))) + result)) + + +;;; General font-locking +(defun clojure-match-next-def () + "Scans the buffer backwards for the next \"top-level\" definition. +Called by `imenu--generic-function'." + ;; we have to take into account namespace-definition forms + ;; e.g. s/defn + (when (re-search-backward "^[ \t]*(\\([a-z0-9.-]+/\\)?\\(def\\sw*\\)" nil t) + (save-excursion + (let (found? + (deftype (match-string 2)) + (start (point))) + (down-list) + (forward-sexp) + (while (not found?) + (ignore-errors + (forward-sexp)) + (or (when (char-equal ?\[ (char-after (point))) + (backward-sexp)) + (when (char-equal ?\) (char-after (point))) + (backward-sexp))) + (cl-destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp) + (if (char-equal ?^ (char-after def-beg)) + (progn (forward-sexp) (backward-sexp)) + (setq found? t) + (when (string= deftype "defmethod") + (setq def-end (progn (goto-char def-end) + (forward-sexp) + (point)))) + (set-match-data (list def-beg def-end))))) + (goto-char start))))) + +(eval-and-compile + (defconst clojure--sym-forbidden-rest-chars "][\";\'@\\^`~\(\)\{\}\\,\s\t\n\r" + "A list of chars that a Clojure symbol cannot contain. +See definition of 'macros': URL `http://git.io/vRGLD'.") + (defconst clojure--sym-forbidden-1st-chars (concat clojure--sym-forbidden-rest-chars "0-9:") + "A list of chars that a Clojure symbol cannot start with. +See the for-loop: URL `http://git.io/vRGTj' lines: URL +`http://git.io/vRGIh', URL `http://git.io/vRGLE' and value +definition of 'macros': URL `http://git.io/vRGLD'.") + (defconst clojure--sym-regexp + (concat "[^" clojure--sym-forbidden-1st-chars "][^" clojure--sym-forbidden-rest-chars "]*") + "A regexp matching a Clojure symbol or namespace alias. +Matches the rule `clojure--sym-forbidden-1st-chars' followed by +any number of matches of `clojure--sym-forbidden-rest-chars'.")) + +(defconst clojure-font-lock-keywords + (eval-when-compile + `( ;; Top-level variable definition + (,(concat "(\\(?:clojure.core/\\)?\\(" + (regexp-opt '("def" "defonce")) + ;; variable declarations + "\\)\\>" + ;; Any whitespace + "[ \r\n\t]*" + ;; Possibly type or metadata + "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" + "\\(\\sw+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face nil t)) + ;; Type definition + (,(concat "(\\(?:clojure.core/\\)?\\(" + (regexp-opt '("defstruct" "deftype" "defprotocol" + "defrecord")) + ;; type declarations + "\\)\\>" + ;; Any whitespace + "[ \r\n\t]*" + ;; Possibly type or metadata + "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" + "\\(\\sw+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ;; Function definition (anything that starts with def and is not + ;; listed above) + (,(concat "(\\(?:" clojure--sym-regexp "/\\)?" + "\\(def[^ \r\n\t]*\\)" + ;; Function declarations + "\\>" + ;; Any whitespace + "[ \r\n\t]*" + ;; Possibly type or metadata + "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" + "\\(\\sw+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-function-name-face nil t)) + ;; (fn name? args ...) + (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+" + ;; Possibly type + "\\(?:#?^\\sw+[ \t]*\\)?" + ;; Possibly name + "\\(\\sw+\\)?" ) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face nil t)) + ;; lambda arguments - %, %&, %1, %2, etc + ("\\<%[&1-9]?" (0 font-lock-variable-name-face)) + ;; Special forms + (,(concat + "(" + (regexp-opt + '("def" "do" "if" "let" "let*" "var" "fn" "fn*" "loop" "loop*" + "recur" "throw" "try" "catch" "finally" + "set!" "new" "." + "monitor-enter" "monitor-exit" "quote") t) + "\\>") + 1 font-lock-keyword-face) + ;; Built-in binding and flow of control forms + (,(concat + "(\\(?:clojure.core/\\)?" + (regexp-opt + '("letfn" "case" "cond" "cond->" "cond->>" "condp" + "for" "when" "when-not" "when-let" "when-first" "when-some" + "if-let" "if-not" "if-some" + ".." "->" "->>" "as->" "doto" "and" "or" + "dosync" "doseq" "dotimes" "dorun" "doall" + "ns" "in-ns" + "with-open" "with-local-vars" "binding" + "with-redefs" "with-redefs-fn" + "declare") t) + "\\>") + 1 font-lock-keyword-face) + ;; Macros similar to let, when, and while + (,(rx symbol-start + (or "let" "when" "while") "-" + (1+ (or (syntax word) (syntax symbol))) + symbol-end) + 0 font-lock-keyword-face) + (,(concat + "\\<" + (regexp-opt + '("*1" "*2" "*3" "*agent*" + "*allow-unresolved-vars*" "*assert*" "*clojure-version*" + "*command-line-args*" "*compile-files*" + "*compile-path*" "*data-readers*" "*default-data-reader-fn*" + "*e" "*err*" "*file*" "*flush-on-newline*" + "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*" + "*print-dup*" "*print-length*" "*print-level*" + "*print-meta*" "*print-readably*" + "*read-eval*" "*source-path*" + "*unchecked-math*" + "*use-context-classloader*" "*warn-on-reflection*") + t) + "\\>") + 0 font-lock-builtin-face) + ;; Dynamic variables - *something* or @*something* + ("\\(?:\\<\\|/\\)@?\\(\\*[a-z-]*\\*\\)\\>" 1 font-lock-variable-name-face) + ;; Global constants - nil, true, false + (,(concat + "\\<" + (regexp-opt + '("true" "false" "nil") t) + "\\>") + 0 font-lock-constant-face) + ;; Character literals - \1, \a, \newline, \u0000 + ("\\\\\\([[:punct:]]\\|[a-z0-9]+\\>\\)" 0 'clojure-character-face) + + ;; namespace definitions: (ns foo.bar) + (,(concat "(\\<ns\\>[ \r\n\t]*" + ;; Possibly metadata + "\\(?:\\^?{[^}]+}[ \r\n\t]*\\)*" + ;; namespace + "\\(" clojure--sym-regexp "\\)") + (1 font-lock-type-face)) + + ;; TODO dedupe the code for matching of keywords, type-hints and unmatched symbols + + ;; keywords: {:oneword/ve/yCom|pLex.stu-ff 0} + (,(concat "\\(:\\{1,2\\}\\)\\(" clojure--sym-regexp "?\\)\\(/\\)\\(" clojure--sym-regexp "\\)") + (1 'clojure-keyword-face) + (2 font-lock-type-face) + ;; (2 'clojure-keyword-face) + (3 'default) + (4 'clojure-keyword-face)) + (,(concat "\\(:\\{1,2\\}\\)\\(" clojure--sym-regexp "\\)") + (1 'clojure-keyword-face) + (2 'clojure-keyword-face)) + + ;; type-hints: #^oneword + (,(concat "\\(#^\\)\\(" clojure--sym-regexp "?\\)\\(/\\)\\(" clojure--sym-regexp "\\)") + (1 'default) + (2 font-lock-type-face) + (3 'default) + (4 'default)) + (,(concat "\\(#^\\)\\(" clojure--sym-regexp "\\)") + (1 'default) + (2 font-lock-type-face)) + + ;; clojure symbols not matched by the previous regexps; influences CIDER's + ;; dynamic syntax highlighting (CDSH). See https://git.io/vxEEA: + (,(concat "\\(" clojure--sym-regexp "?\\)\\(/\\)\\(" clojure--sym-regexp "\\)") + (1 font-lock-type-face) + ;; 2nd and 3th matching groups can be font-locked to `nil' or `default'. + ;; CDSH seems to kick in only for functions and variables referenced w/o + ;; writing their namespaces. + (2 nil) + (3 nil)) + (,(concat "\\(" clojure--sym-regexp "\\)") + ;; this matching group must be font-locked to `nil' otherwise CDSH breaks. + (1 nil)) + + ;; #_ and (comment ...) macros. + (clojure--search-comment-macro 1 font-lock-comment-face t) + ;; Highlight `code` marks, just like `elisp'. + (,(rx "`" (group-n 1 (optional "#'") + (+ (or (syntax symbol) (syntax word)))) "`") + (1 'font-lock-constant-face prepend)) + ;; Highlight escaped characters in strings. + (clojure-font-lock-escaped-chars 0 'bold prepend) + ;; Highlight grouping constructs in regular expressions + (clojure-font-lock-regexp-groups + (1 'font-lock-regexp-grouping-construct prepend)))) + "Default expressions to highlight in Clojure mode.") + +(defun clojure-font-lock-syntactic-face-function (state) + "Find and highlight text with a Clojure-friendly syntax table. + +This function is passed to `font-lock-syntactic-face-function', +which is called with a single parameter, STATE (which is, in +turn, returned by `parse-partial-sexp' at the beginning of the +highlighted region)." + (if (nth 3 state) + ;; This might be a (doc)string or a |...| symbol. + (let ((startpos (nth 8 state))) + (if (eq (char-after startpos) ?|) + ;; This is not a string, but a |...| symbol. + nil + (let* ((listbeg (nth 1 state)) + (firstsym (and listbeg + (save-excursion + (goto-char listbeg) + (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") + (match-string 1))))) + (docelt (and firstsym + (function-get (intern-soft firstsym) + lisp-doc-string-elt-property)))) + (if (and docelt + ;; It's a string in a form that can have a docstring. + ;; Check whether it's in docstring position. + (save-excursion + (when (functionp docelt) + (goto-char (match-end 1)) + (setq docelt (funcall docelt))) + (goto-char listbeg) + (forward-char 1) + (ignore-errors + (while (and (> docelt 0) (< (point) startpos) + (progn (forward-sexp 1) t)) + ;; ignore metadata and type hints + (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)") + (setq docelt (1- docelt))))) + (and (zerop docelt) (<= (point) startpos) + (progn (forward-comment (point-max)) t) + (= (point) (nth 8 state))))) + font-lock-doc-face + font-lock-string-face)))) + font-lock-comment-face)) + +(defun clojure-font-lock-setup () + "Configures font-lock for editing Clojure code." + (setq-local font-lock-multiline t) + (add-to-list 'font-lock-extend-region-functions + #'clojure-font-lock-extend-region-def t) + (setq font-lock-defaults + '(clojure-font-lock-keywords ; keywords + nil nil + (("+-*/.<>=!?$%_&:" . "w")) ; syntax alist + nil + (font-lock-mark-block-function . mark-defun) + (font-lock-syntactic-face-function + . clojure-font-lock-syntactic-face-function)))) + +(defun clojure-font-lock-def-at-point (point) + "Range between the top-most def* and the fourth element after POINT. +Note that this means that there is no guarantee of proper font +locking in def* forms that are not at top level." + (goto-char point) + (ignore-errors + (beginning-of-defun)) + + (let ((beg-def (point))) + (when (and (not (= point beg-def)) + (looking-at "(def")) + (ignore-errors + ;; move forward as much as possible until failure (or success) + (forward-char) + (dotimes (_ 4) + (forward-sexp))) + (cons beg-def (point))))) + +(defun clojure-font-lock-extend-region-def () + "Set region boundaries to include the first four elements of def* forms." + (let ((changed nil)) + (let ((def (clojure-font-lock-def-at-point font-lock-beg))) + (when def + (cl-destructuring-bind (def-beg . def-end) def + (when (and (< def-beg font-lock-beg) + (< font-lock-beg def-end)) + (setq font-lock-beg def-beg + changed t))))) + (let ((def (clojure-font-lock-def-at-point font-lock-end))) + (when def + (cl-destructuring-bind (def-beg . def-end) def + (when (and (< def-beg font-lock-end) + (< font-lock-end def-end)) + (setq font-lock-end def-end + changed t))))) + changed)) + +(defun clojure--font-locked-as-string-p (&optional regexp) + "Non-nil if the char before point is font-locked as a string. +If REGEXP is non-nil, also check whether current string is +preceeded by a #." + (let ((face (get-text-property (1- (point)) 'face))) + (and (or (and (listp face) + (memq 'font-lock-string-face face)) + (eq 'font-lock-string-face face)) + (or (clojure-string-start t) + (unless regexp + (clojure-string-start nil)))))) + +(defun clojure-font-lock-escaped-chars (bound) + "Highlight \escaped chars in strings. +BOUND denotes a buffer position to limit the search." + (let ((found nil)) + (while (and (not found) + (re-search-forward "\\\\." bound t)) + + (setq found (clojure--font-locked-as-string-p))) + found)) + +(defun clojure-font-lock-regexp-groups (bound) + "Highlight grouping constructs in regular expression. + +BOUND denotes the maximum number of characters (relative to the +point) to check." + (let ((found nil)) + (while (and (not found) + (re-search-forward (eval-when-compile + (concat + ;; A group may start using several alternatives: + "\\(\\(?:" + ;; 1. (? special groups + "(\\?\\(?:" + ;; a) non-capturing group (?:X) + ;; b) independent non-capturing group (?>X) + ;; c) zero-width positive lookahead (?=X) + ;; d) zero-width negative lookahead (?!X) + "[:=!>]\\|" + ;; e) zero-width positive lookbehind (?<=X) + ;; f) zero-width negative lookbehind (?<!X) + "<[=!]\\|" + ;; g) named capturing group (?<name>X) + "<[[:alnum:]]+>" + "\\)\\|" ;; end of special groups + ;; 2. normal capturing groups ( + ;; 3. we also highlight alternative + ;; separarators |, and closing parens ) + "[|()]" + "\\)\\)")) + bound t)) + (setq found (clojure--font-locked-as-string-p 'regexp))) + found)) + +;; Docstring positions +(put 'ns 'clojure-doc-string-elt 2) +(put 'def 'clojure-doc-string-elt 2) +(put 'defn 'clojure-doc-string-elt 2) +(put 'defn- 'clojure-doc-string-elt 2) +(put 'defmulti 'clojure-doc-string-elt 2) +(put 'defmacro 'clojure-doc-string-elt 2) +(put 'definline 'clojure-doc-string-elt 2) +(put 'defprotocol 'clojure-doc-string-elt 2) +(put 'deftask 'clojure-doc-string-eld 2) ;; common Boot macro + +;;; Vertical alignment +(defcustom clojure-align-forms-automatically nil + "If non-nil, vertically align some forms automatically. +Automatically means it is done as part of indenting code. This +applies to binding forms (`clojure-align-binding-forms'), to cond +forms (`clojure-align-cond-forms') and to map literals. For +instance, selecting a map a hitting \\<clojure-mode-map>`\\[indent-for-tab-command]' +will align the values like this: + {:some-key 10 + :key2 20}" + :package-version '(clojure-mode . "5.1") + :safe #'booleanp + :type 'boolean) + +(defcustom clojure-align-binding-forms + '("let" "when-let" "when-some" "if-let" "if-some" "binding" "loop" + "doseq" "for" "with-open" "with-local-vars" "with-redefs") + "List of strings matching forms that have binding forms." + :package-version '(clojure-mode . "5.1") + :safe #'listp + :type '(repeat string)) + +(defcustom clojure-align-cond-forms '("condp" "cond" "cond->" "cond->>" "case" "are") + "List of strings identifying cond-like forms." + :package-version '(clojure-mode . "5.1") + :safe #'listp + :type '(repeat string)) + +(defun clojure--position-for-alignment () + "Non-nil if the sexp around point should be automatically aligned. +This function expects to be called immediately after an +open-brace or after the function symbol in a function call. + +First check if the sexp around point is a map literal, or is a +call to one of the vars listed in `clojure-align-cond-forms'. If +it isn't, return nil. If it is, return non-nil and place point +immediately before the forms that should be aligned. + +For instance, in a map literal point is left immediately before +the first key; while, in a let-binding, point is left inside the +binding vector and immediately before the first binding +construct." + ;; Are we in a map? + (or (and (eq (char-before) ?{) + (not (eq (char-before (1- (point))) ?\#))) + ;; Are we in a cond form? + (let* ((fun (car (member (thing-at-point 'symbol) clojure-align-cond-forms))) + (method (and fun (clojure--get-indent-method fun))) + ;; The number of special arguments in the cond form is + ;; the number of sexps we skip before aligning. + (skip (cond ((numberp method) method) + ((null method) 0) + ((sequencep method) (elt method 0))))) + (when (and fun (numberp skip)) + (clojure-forward-logical-sexp skip) + (comment-forward (point-max)) + fun)) ; Return non-nil (the var name). + ;; Are we in a let-like form? + (when (member (thing-at-point 'symbol) + clojure-align-binding-forms) + ;; Position inside the binding vector. + (clojure-forward-logical-sexp) + (backward-sexp) + (when (eq (char-after) ?\[) + (forward-char 1) + (comment-forward (point-max)) + ;; Return non-nil. + t)))) + +(defun clojure--find-sexp-to-align (end) + "Non-nil if there's a sexp ahead to be aligned before END. +Place point as in `clojure--position-for-alignment'." + ;; Look for a relevant sexp. + (let ((found)) + (while (and (not found) + (search-forward-regexp + (concat "{\\|(" (regexp-opt + (append clojure-align-binding-forms + clojure-align-cond-forms) + 'symbols)) + end 'noerror)) + + (let ((ppss (syntax-ppss))) + ;; If we're in a string or comment. + (unless (or (elt ppss 3) + (elt ppss 4)) + ;; Only stop looking if we successfully position + ;; the point. + (setq found (clojure--position-for-alignment))))) + found)) + +(defun clojure--search-whitespace-after-next-sexp (&optional bound _noerror) + "Move point after all whitespace after the next sexp. + +Set the match data group 1 to be this region of whitespace and +return point. + +BOUND is bounds the whitespace search." + (unwind-protect + (ignore-errors + (clojure-forward-logical-sexp 1) + (search-forward-regexp "\\([,\s\t]*\\)" bound) + (pcase (syntax-after (point)) + ;; End-of-line, try again on next line. + (`(12) (clojure--search-whitespace-after-next-sexp bound)) + ;; Closing paren, stop here. + (`(5 . ,_) nil) + ;; Anything else is something to align. + (_ (point)))) + (when (and bound (> (point) bound)) + (goto-char bound)))) + +(defun clojure-align (beg end) + "Vertically align the contents of the sexp around point. +If region is active, align it. Otherwise, align everything in the +current \"top-level\" sexp. +When called from lisp code align everything between BEG and END." + (interactive (if (use-region-p) + (list (region-beginning) (region-end)) + (save-excursion + (let ((end (progn (end-of-defun) + (point)))) + (clojure-backward-logical-sexp) + (list (point) end))))) + (setq end (copy-marker end)) + (save-excursion + (goto-char beg) + (while (clojure--find-sexp-to-align end) + (let ((sexp-end (save-excursion + (backward-up-list) + (forward-sexp 1) + (point-marker))) + (clojure-align-forms-automatically nil) + (count 1)) + ;; For some bizarre reason, we need to `align-region' once for each + ;; group. + (save-excursion + (while (search-forward-regexp "^ *\n" sexp-end 'noerror) + (cl-incf count))) + (dotimes (_ count) + (align-region (point) sexp-end nil + '((clojure-align (regexp . clojure--search-whitespace-after-next-sexp) + (group . 1) + (separate . "^ *$") + (repeat . t))) + nil)) + ;; Reindent after aligning because of #360. + (indent-region (point) sexp-end))))) + +;;; Indentation +(defun clojure-indent-region (beg end) + "Like `indent-region', but also maybe align forms. +Forms between BEG and END are aligned according to +`clojure-align-forms-automatically'." + (prog1 (let ((indent-region-function nil)) + (indent-region beg end)) + (when clojure-align-forms-automatically + (condition-case nil + (clojure-align beg end) + (scan-error nil))))) + +(defun clojure-indent-line () + "Indent current line as Clojure code." + (if (clojure-in-docstring-p) + (save-excursion + (beginning-of-line) + (when (and (looking-at "^\\s-*") + (<= (string-width (match-string-no-properties 0)) + (string-width (clojure-docstring-fill-prefix)))) + (replace-match (clojure-docstring-fill-prefix)))) + (lisp-indent-line))) + +(defvar clojure-get-indent-function nil + "Function to get the indent spec of a symbol. +This function should take one argument, the name of the symbol as +a string. This name will be exactly as it appears in the buffer, +so it might start with a namespace alias. + +This function is analogous to the `clojure-indent-function' +symbol property, and its return value should match one of the +allowed values of this property. See `clojure-indent-function' +for more information.") + +(defun clojure--get-indent-method (function-name) + "Return the indent spec for the symbol named FUNCTION-NAME. +FUNCTION-NAME is a string. If it contains a `/', also try only +the part after the `/'. + +Look for a spec using `clojure-get-indent-function', then try the +`clojure-indent-function' and `clojure-backtracking-indent' +symbol properties." + (or (when (functionp clojure-get-indent-function) + (funcall clojure-get-indent-function function-name)) + (get (intern-soft function-name) 'clojure-indent-function) + (get (intern-soft function-name) 'clojure-backtracking-indent) + (when (string-match "/\\([^/]+\\)\\'" function-name) + (or (get (intern-soft (match-string 1 function-name)) + 'clojure-indent-function) + (get (intern-soft (match-string 1 function-name)) + 'clojure-backtracking-indent))) + (when (string-match (rx (or "let" "when" "while") (syntax symbol)) + function-name) + (clojure--get-indent-method (substring (match-string 0 function-name) 0 -1))))) + +(defvar clojure--current-backtracking-depth 0) + +(defun clojure--find-indent-spec-backtracking () + "Return the indent sexp that applies to the sexp at point. +Implementation function for `clojure--find-indent-spec'." + (when (and (>= clojure-max-backtracking clojure--current-backtracking-depth) + (not (looking-at "^"))) + (let ((clojure--current-backtracking-depth (1+ clojure--current-backtracking-depth)) + (pos 0)) + ;; Count how far we are from the start of the sexp. + (while (ignore-errors (clojure-backward-logical-sexp 1) + (not (or (bobp) + (eq (char-before) ?\n)))) + (cl-incf pos)) + (let* ((function (thing-at-point 'symbol)) + (method (or (when function ;; Is there a spec here? + (clojure--get-indent-method function)) + (ignore-errors + ;; Otherwise look higher up. + (pcase (syntax-ppss) + (`(,(pred (< 0)) ,start . ,_) + (goto-char start) + (clojure--find-indent-spec-backtracking))))))) + (when (numberp method) + (setq method (list method))) + (pcase method + ((pred functionp) + (when (= pos 0) + method)) + ((pred sequencep) + (pcase (length method) + (`0 nil) + (`1 (let ((head (elt method 0))) + (when (or (= pos 0) (sequencep head)) + head))) + (l (if (>= pos l) + (elt method (1- l)) + (elt method pos))))) + ((or `defun `:defn) + (when (= pos 0) + :defn)) + (_ + (message "Invalid indent spec for `%s': %s" function method) + nil)))))) + +(defun clojure--find-indent-spec () + "Return the indent spec that applies to current sexp. +If `clojure-use-backtracking-indent' is non-nil, also do +backtracking up to a higher-level sexp in order to find the +spec." + (if clojure-use-backtracking-indent + (save-excursion + (clojure--find-indent-spec-backtracking)) + (let ((function (thing-at-point 'symbol))) + (clojure--get-indent-method function)))) + +(defun clojure--normal-indent (last-sexp indent-mode) + "Return the normal indentation column for a sexp. +Point should be after the open paren of the _enclosing_ sexp, and +LAST-SEXP is the start of the previous sexp (immediately before +the sexp being indented). INDENT-MODE is any of the values +accepted by `clojure-indent-style'." + (goto-char last-sexp) + (forward-sexp 1) + (clojure-backward-logical-sexp 1) + (let ((last-sexp-start nil)) + (if (ignore-errors + ;; `backward-sexp' until we reach the start of a sexp that is the + ;; first of its line (the start of the enclosing sexp). + (while (string-match + "[^[:blank:]]" + (buffer-substring (line-beginning-position) (point))) + (setq last-sexp-start (prog1 (point) + (forward-sexp -1)))) + t) + ;; Here we have found an arg before the arg we're indenting which is at + ;; the start of a line. Every mode simply aligns on this case. + (current-column) + ;; Here we have reached the start of the enclosing sexp (point is now at + ;; the function name), so the behaviour depends on INDENT-MODE and on + ;; whether there's also an argument on this line (case A or B). + (let ((case-a ; The meaning of case-a is explained in `clojure-indent-style'. + (and last-sexp-start + (< last-sexp-start (line-end-position))))) + (cond + ;; For compatibility with the old `clojure-defun-style-default-indent', any + ;; value other than these 3 is equivalent to `always-body'. + ((not (memq indent-mode '(:always-align :align-arguments nil))) + (+ (current-column) lisp-body-indent -1)) + ;; There's an arg after the function name, so align with it. + (case-a (goto-char last-sexp-start) + (current-column)) + ;; Not same line. + ((eq indent-mode :align-arguments) + (+ (current-column) lisp-body-indent -1)) + ;; Finally, just align with the function name. + (t (current-column))))))) + +(defun clojure--not-function-form-p () + "Non-nil if form at point doesn't represent a function call." + (or (member (char-after) '(?\[ ?\{)) + (save-excursion ;; Catch #?@ (:cljs ...) + (skip-chars-backward "\r\n[:blank:]") + (when (eq (char-before) ?@) + (forward-char -1)) + (and (eq (char-before) ?\?) + (eq (char-before (1- (point))) ?\#))) + ;; Car of form is not a symbol. + (not (looking-at ".\\(?:\\sw\\|\\s_\\)")))) + +;; Check the general context, and provide indentation for data structures and +;; special macros. If current form is a function (or non-special macro), +;; delegate indentation to `clojure--normal-indent'. +(defun clojure-indent-function (indent-point state) + "When indenting a line within a function call, indent properly. + +INDENT-POINT is the position where the user typed TAB, or equivalent. +Point is located at the point to indent under (for default indentation); +STATE is the `parse-partial-sexp' state for that position. + +If the current line is in a call to a Clojure function with a +non-nil property `clojure-indent-function', that specifies how to do +the indentation. + +The property value can be + +- `defun', meaning indent `defun'-style; +- an integer N, meaning indent the first N arguments specially + like ordinary function arguments and then indent any further + arguments like a body; +- a function to call just as this function was called. + If that function returns nil, that means it doesn't specify + the indentation. +- a list, which is used by `clojure-backtracking-indent'. + +This function also returns nil meaning don't specify the indentation." + ;; Goto to the open-paren. + (goto-char (elt state 1)) + ;; Maps, sets, vectors and reader conditionals. + (if (clojure--not-function-form-p) + (1+ (current-column)) + ;; Function or macro call. + (forward-char 1) + (let ((method (clojure--find-indent-spec)) + (last-sexp calculate-lisp-indent-last-sexp) + (containing-form-column (1- (current-column)))) + (pcase method + ((or (pred integerp) `(,method)) + (let ((pos -1)) + (condition-case nil + (while (and (<= (point) indent-point) + (not (eobp))) + (clojure-forward-logical-sexp 1) + (cl-incf pos)) + ;; If indent-point is _after_ the last sexp in the + ;; current sexp, we detect that by catching the + ;; `scan-error'. In that case, we should return the + ;; indentation as if there were an extra sexp at point. + (scan-error (cl-incf pos))) + (cond + ;; The first non-special arg. Rigidly reduce indentation. + ((= pos (1+ method)) + (+ lisp-body-indent containing-form-column)) + ;; Further non-special args, align with the arg above. + ((> pos (1+ method)) + (clojure--normal-indent last-sexp :always-align)) + ;; Special arg. Rigidly indent with a large indentation. + (t + (+ (* 2 lisp-body-indent) containing-form-column))))) + (`:defn + (+ lisp-body-indent containing-form-column)) + ((pred functionp) + (funcall method indent-point state)) + ;; No indent spec, do the default. + (`nil + (let ((function (thing-at-point 'symbol))) + (cond + ;; Preserve useful alignment of :require (and friends) in `ns' forms. + ((and function (string-match "^:" function)) + (clojure--normal-indent last-sexp :always-align)) + ;; This is should be identical to the :defn above. + ((and function + (string-match "\\`\\(?:\\S +/\\)?\\(def[a-z]*\\|with-\\)" + function) + (not (string-match "\\`default" (match-string 1 function)))) + (+ lisp-body-indent containing-form-column)) + ;; Finally, nothing special here, just respect the user's + ;; preference. + (t (clojure--normal-indent last-sexp clojure-indent-style))))))))) + +;;; Setting indentation +(defun put-clojure-indent (sym indent) + "Instruct `clojure-indent-function' to indent the body of SYM by INDENT." + (put sym 'clojure-indent-function indent)) + +(defmacro define-clojure-indent (&rest kvs) + "Call `put-clojure-indent' on a series, KVS." + `(progn + ,@(mapcar (lambda (x) `(put-clojure-indent + (quote ,(car x)) ,(cadr x))) + kvs))) + +(defun add-custom-clojure-indents (name value) + "Allow `clojure-defun-indents' to indent user-specified macros. + +Requires the macro's NAME and a VALUE." + (custom-set-default name value) + (mapcar (lambda (x) + (put-clojure-indent x 'defun)) + value)) + +(defcustom clojure-defun-indents nil + "List of additional symbols with defun-style indentation in Clojure. + +You can use this to let Emacs indent your own macros the same way +that it indents built-in macros like with-open. This variable +only works when set via the customize interface (`setq' won't +work). To set it from Lisp code, use + (put-clojure-indent \\='some-symbol :defn)." + :type '(repeat symbol) + :set 'add-custom-clojure-indents) + +(define-clojure-indent + ;; built-ins + (ns 1) + (fn :defn) + (def :defn) + (defn :defn) + (bound-fn :defn) + (if 1) + (if-not 1) + (case 1) + (cond 0) + (condp 2) + (cond-> 1) + (cond->> 1) + (when 1) + (while 1) + (when-not 1) + (when-first 1) + (do 0) + (future 0) + (comment 0) + (doto 1) + (locking 1) + (proxy '(2 nil nil (:defn))) + (as-> 2) + (fdef 1) + + (reify '(:defn (1))) + (deftype '(2 nil nil (:defn))) + (defrecord '(2 nil nil (:defn))) + (defprotocol '(1 (:defn))) + (definterface '(1 (:defn))) + (extend 1) + (extend-protocol '(1 :defn)) + (extend-type '(1 :defn)) + ;; specify and specify! are from ClojureScript + (specify '(1 :defn)) + (specify! '(1 :defn)) + (try 0) + (catch 2) + (finally 0) + + ;; binding forms + (let 1) + (letfn '(1 ((:defn)) nil)) + (binding 1) + (loop 1) + (for 1) + (doseq 1) + (dotimes 1) + (when-let 1) + (if-let 1) + (when-some 1) + (if-some 1) + (this-as 1) ; ClojureScript + + (defmethod :defn) + + ;; clojure.test + (testing 1) + (deftest :defn) + (are 2) + (use-fixtures :defn) + + ;; core.logic + (run :defn) + (run* :defn) + (fresh :defn) + + ;; core.async + (alt! 0) + (alt!! 0) + (go 0) + (go-loop 1) + (thread 0)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Better docstring filling for clojure-mode +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun clojure-string-start (&optional regex) + "Return the position of the \" that begins the string at point. +If REGEX is non-nil, return the position of the # that begins the +regex at point. If point is not inside a string or regex, return +nil." + (when (nth 3 (syntax-ppss)) ;; Are we really in a string? + (save-excursion + (save-match-data + ;; Find a quote that appears immediately after whitespace, + ;; beginning of line, hash, or an open paren, brace, or bracket + (re-search-backward "\\(\\s-\\|^\\|#\\|(\\|\\[\\|{\\)\\(\"\\)") + (let ((beg (match-beginning 2))) + (when beg + (if regex + (and (char-before beg) (eq ?# (char-before beg)) (1- beg)) + (when (not (eq ?# (char-before beg))) + beg)))))))) + +(defun clojure-char-at-point () + "Return the char at point or nil if at buffer end." + (when (not (= (point) (point-max))) + (buffer-substring-no-properties (point) (1+ (point))))) + +(defun clojure-char-before-point () + "Return the char before point or nil if at buffer beginning." + (when (not (= (point) (point-min))) + (buffer-substring-no-properties (point) (1- (point))))) + +(defun clojure-toggle-keyword-string () + "Convert the string or keyword at point to keyword or string." + (interactive) + (let ((original-point (point))) + (while (and (> (point) 1) + (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))) + (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))))) + (backward-char)) + (cond + ((equal 1 (point)) + (error "Beginning of file reached, this was probably a mistake")) + ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))) + (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1))) + ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))) + (insert "\"" (substring (clojure-delete-and-extract-sexp) 1) "\""))) + (goto-char original-point))) + +(defun clojure-delete-and-extract-sexp () + "Delete the surrounding sexp and return it." + (let ((begin (point))) + (forward-sexp) + (let ((result (buffer-substring begin (point)))) + (delete-region begin (point)) + result))) + + + +(defcustom clojure-cache-project-dir t + "Whether to cache the results of `clojure-project-dir'." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-mode . "5.8.0")) + +(defvar-local clojure-cached-project-dir nil + "A project dir cache used to speed up related operations.") + +(defun clojure-project-dir (&optional dir-name) + "Return the absolute path to the project's root directory. + +Call is delegated down to `clojure-project-root-function' with +optional DIR-NAME as argument. + +When `clojure-cache-project-dir' is t the results of the command +are cached in a buffer local variable (`clojure-cached-project-dir')." + (let ((project-dir (or clojure-cached-project-dir + (funcall clojure-project-root-function dir-name)))) + (when (and clojure-cache-project-dir + (derived-mode-p 'clojure-mode) + (not clojure-cached-project-dir)) + (setq clojure-cached-project-dir project-dir)) + project-dir)) + +(defun clojure-current-project (&optional dir-name) + "Return the current project as a cons cell usable by project.el. + +Call is delegated down to `clojure-clojure-dir' with +optional DIR-NAME as argument." + (let ((project-dir (clojure-project-dir dir-name))) + (if project-dir + (cons 'clojure project-dir) + nil))) + +(defun clojure-project-root-path (&optional dir-name) + "Return the absolute path to the project's root directory. + +Use `default-directory' if DIR-NAME is nil. +Return nil if not inside a project." + (let* ((dir-name (or dir-name default-directory)) + (choices (delq nil + (mapcar (lambda (fname) + (locate-dominating-file dir-name fname)) + clojure-build-tool-files)))) + (when (> (length choices) 0) + (car (sort choices #'file-in-directory-p))))) + +(defun clojure-project-relative-path (path) + "Denormalize PATH by making it relative to the project root." + (file-relative-name path (clojure-project-dir))) + + +;;; ns manipulation +(defun clojure-expected-ns (&optional path) + "Return the namespace matching PATH. + +PATH is expected to be an absolute file path. + +If PATH is nil, use the path to the file backing the current buffer." + (let* ((path (or path (file-truename (buffer-file-name)))) + (relative (clojure-project-relative-path path)) + (sans-file-type (substring relative 0 (- (length (file-name-extension path t))))) + (sans-file-sep (mapconcat 'identity (cdr (split-string sans-file-type "/")) ".")) + (sans-underscores (replace-regexp-in-string "_" "-" sans-file-sep))) + ;; Drop prefix from ns for projects with structure src/{clj,cljs,cljc} + (replace-regexp-in-string "\\`clj[scx]?\\." "" sans-underscores))) + +(defun clojure-insert-ns-form-at-point () + "Insert a namespace form at point." + (interactive) + (insert (format "(ns %s)" (funcall clojure-expected-ns-function)))) + +(defun clojure-insert-ns-form () + "Insert a namespace form at the beginning of the buffer." + (interactive) + (widen) + (goto-char (point-min)) + (clojure-insert-ns-form-at-point)) + +(defun clojure-update-ns () + "Update the namespace of the current buffer. +Useful if a file has been renamed." + (interactive) + (let ((nsname (funcall clojure-expected-ns-function))) + (when nsname + (save-excursion + (save-match-data + (if (clojure-find-ns) + (progn + (replace-match nsname nil nil nil 4) + (message "ns form updated to `%s'" nsname) + (setq clojure-cached-ns nsname)) + (error "Namespace not found"))))))) + +(defun clojure--sort-following-sexps () + "Sort sexps between point and end of current sexp. +Comments at the start of a line are considered part of the +following sexp. Comments at the end of a line (after some other +content) are considered part of the preceding sexp." + ;; Here we're after the :require/:import symbol. + (save-restriction + (narrow-to-region (point) (save-excursion + (up-list) + (1- (point)))) + (skip-chars-forward "\r\n[:blank:]") + (sort-subr nil + (lambda () (skip-chars-forward "\r\n[:blank:]")) + ;; Move to end of current top-level thing. + (lambda () + (condition-case nil + (while t (up-list)) + (scan-error nil)) + ;; We could be inside a symbol instead of a sexp. + (unless (looking-at "\\s-\\|$") + (clojure-forward-logical-sexp)) + ;; move past comments at the end of the line. + (search-forward-regexp "$")) + ;; Move to start of ns name. + (lambda () + (comment-forward) + (skip-chars-forward "[:blank:]\n\r[(") + (clojure-forward-logical-sexp) + (forward-sexp -1) + nil) + ;; Move to end of ns name. + (lambda () + (clojure-forward-logical-sexp))) + (goto-char (point-max)) + ;; Does the last line now end in a comment? + (when (nth 4 (parse-partial-sexp (point-min) (point))) + (insert "\n")))) + +(defun clojure-sort-ns () + "Internally sort each sexp inside the ns form." + (interactive) + (comment-normalize-vars) + (if (clojure-find-ns) + (save-excursion + (goto-char (match-beginning 0)) + (redisplay) + (let ((beg (point)) + (ns)) + (forward-sexp 1) + (setq ns (buffer-substring beg (point))) + (forward-char -1) + (while (progn (forward-sexp -1) + (looking-at "(:[a-z]")) + (save-excursion + (forward-char 1) + (forward-sexp 1) + (clojure--sort-following-sexps))) + (goto-char beg) + (if (looking-at (regexp-quote ns)) + (message "ns form is already sorted") + (sleep-for 0.1) + (redisplay) + (message "ns form has been sorted") + (sleep-for 0.1)))) + (user-error "Namespace not found"))) + +(defconst clojure-namespace-name-regex + (rx line-start + "(" + (zero-or-one (group (regexp "clojure.core/"))) + (zero-or-one (submatch "in-")) + "ns" + (zero-or-one "+") + (one-or-more (any whitespace "\n")) + (zero-or-more (or (submatch (zero-or-one "#") + "^{" + (zero-or-more (not (any "}"))) + "}") + (zero-or-more "^:" + (one-or-more (not (any whitespace))))) + (one-or-more (any whitespace "\n"))) + (zero-or-one (any ":'")) ;; (in-ns 'foo) or (ns+ :user) + (group (one-or-more (not (any "()\"" whitespace))) symbol-end))) + +(defcustom clojure-cache-ns t + "Whether to cache the results of `clojure-find-ns'. + +Note that this won't work well in buffers with multiple namespace +declarations (which rarely occur in practice) and you'll +have to invalidate this manually after changing the ns for +a buffer." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-mode . "5.8.0")) + +(defvar-local clojure-cached-ns nil + "A buffer ns cache used to speed up ns-related operations.") + +(defun clojure-find-ns () + "Return the namespace of the current Clojure buffer. +Return the namespace closest to point and above it. If there are +no namespaces above point, return the first one in the buffer. + +The results will be cached if `clojure-cache-ns' is set to t." + (if (and clojure-cache-ns clojure-cached-ns) + clojure-cached-ns + (let ((ns (save-excursion + (save-restriction + (widen) + + ;; Move to top-level to avoid searching from inside ns + (ignore-errors (while t (up-list nil t t))) + + ;; The closest ns form above point. + (when (or (re-search-backward clojure-namespace-name-regex nil t) + ;; Or any form at all. + (and (goto-char (point-min)) + (re-search-forward clojure-namespace-name-regex nil t))) + (match-string-no-properties 4)))))) + (setq clojure-cached-ns ns) + ns))) + +(defun clojure-show-cache () + "Display cached values if present. +Useful for debugging." + (interactive) + (message "Cached Project: %s, Cached Namespace: %s" clojure-cached-project-dir clojure-cached-ns)) + +(defun clojure-clear-cache () + "Clear all buffer-local cached values. + +Normally you'd need to do this very infrequently - e.g. +after renaming the root folder of project or after +renaming a namespace." + (interactive) + (setq clojure-cached-project-dir nil + clojure-cached-ns nil) + (message "Buffer-local clojure-mode cache cleared")) + +(defconst clojure-def-type-and-name-regex + (concat "(\\(?:\\(?:\\sw\\|\\s_\\)+/\\)?" + ;; Declaration + "\\(def\\(?:\\sw\\|\\s_\\)*\\)\\>" + ;; Any whitespace + "[ \r\n\t]*" + ;; Possibly type or metadata + "\\(?:#?^\\(?:{[^}]*}\\|\\(?:\\sw\\|\\s_\\)+\\)[ \r\n\t]*\\)*" + ;; Symbol name + "\\(\\(?:\\sw\\|\\s_\\)+\\)")) + +(defun clojure-find-def () + "Find the var declaration macro and symbol name of the current form. +Returns a list pair, e.g. (\"defn\" \"abc\") or (\"deftest\" \"some-test\")." + (save-excursion + (unless (looking-at clojure-def-type-and-name-regex) + (beginning-of-defun)) + (when (search-forward-regexp clojure-def-type-and-name-regex nil t) + (list (match-string-no-properties 1) + (match-string-no-properties 2))))) + + +;;; Sexp navigation +(defun clojure--looking-at-non-logical-sexp () + "Return non-nil if text after point is \"non-logical\" sexp. +\"Non-logical\" sexp are ^metadata and #reader.macros." + (comment-normalize-vars) + (comment-forward (point-max)) + (looking-at-p "\\^\\|#[[:alpha:]]")) + +(defun clojure-forward-logical-sexp (&optional n) + "Move forward N logical sexps. +This will skip over sexps that don't represent objects, so that ^hints and +#reader.macros are considered part of the following sexp." + (interactive "p") + (unless n (setq n 1)) + (if (< n 0) + (clojure-backward-logical-sexp (- n)) + (let ((forward-sexp-function nil)) + (while (> n 0) + (while (clojure--looking-at-non-logical-sexp) + (forward-sexp 1)) + ;; The actual sexp + (forward-sexp 1) + (skip-chars-forward ",") + (setq n (1- n)))))) + +(defun clojure-backward-logical-sexp (&optional n) + "Move backward N logical sexps. +This will skip over sexps that don't represent objects, so that ^hints and +#reader.macros are considered part of the following sexp." + (interactive "p") + (unless n (setq n 1)) + (if (< n 0) + (clojure-forward-logical-sexp (- n)) + (let ((forward-sexp-function nil)) + (while (> n 0) + ;; The actual sexp + (backward-sexp 1) + ;; Non-logical sexps. + (while (and (not (bobp)) + (ignore-errors + (save-excursion + (backward-sexp 1) + (clojure--looking-at-non-logical-sexp)))) + (backward-sexp 1)) + (setq n (1- n)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Refactoring support +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Threading macros related +(defcustom clojure-thread-all-but-last nil + "Non-nil means do not thread the last expression. +This means that `clojure-thread-first-all' and +`clojure-thread-last-all' not thread the deepest sexp inside the +current sexp." + :package-version '(clojure-mode . "5.4.0") + :safe #'booleanp + :type 'boolean) + +(defun clojure--point-after (&rest actions) + "Return POINT after performing ACTIONS. + +An action is either the symbol of a function or a two element +list of (fn args) to pass to `apply''" + (save-excursion + (dolist (fn-and-args actions) + (let ((f (if (listp fn-and-args) (car fn-and-args) fn-and-args)) + (args (if (listp fn-and-args) (cdr fn-and-args) nil))) + (apply f args))) + (point))) + +(defun clojure--maybe-unjoin-line () + "Undo a `join-line' done by a threading command." + (when (get-text-property (point) 'clojure-thread-line-joined) + (remove-text-properties (point) (1+ (point)) '(clojure-thread-line-joined t)) + (insert "\n"))) + +(defun clojure--unwind-last () + "Unwind a thread last macro once. + +Point must be between the opening paren and the ->> symbol." + (forward-sexp) + (save-excursion + (let ((beg (point)) + (contents (clojure-delete-and-extract-sexp))) + (when (looking-at " *\n") + (join-line 'following)) + (clojure--ensure-parens-around-function-names) + (let* ((sexp-beg-line (line-number-at-pos)) + (sexp-end-line (progn (forward-sexp) + (line-number-at-pos))) + (multiline-sexp-p (not (= sexp-beg-line sexp-end-line)))) + (down-list -1) + (if multiline-sexp-p + (insert "\n") + ;; `clojure--maybe-unjoin-line' only works when unwinding sexps that were + ;; threaded in the same Emacs session, but it also catches cases that + ;; `multiline-sexp-p' doesn't. + (clojure--maybe-unjoin-line)) + (insert contents)))) + (forward-char)) + +(defun clojure--ensure-parens-around-function-names () + "Insert parens around function names if necessary." + (clojure--looking-at-non-logical-sexp) + (unless (looking-at "(") + (insert-parentheses 1) + (backward-up-list))) + +(defun clojure--unwind-first () + "Unwind a thread first macro once. + +Point must be between the opening paren and the -> symbol." + (forward-sexp) + (save-excursion + (let ((contents (clojure-delete-and-extract-sexp))) + (when (looking-at " *\n") + (join-line 'following)) + (clojure--ensure-parens-around-function-names) + (down-list) + (forward-sexp) + (insert contents) + (forward-sexp -1) + (clojure--maybe-unjoin-line))) + (forward-char)) + +(defun clojure--pop-out-of-threading () + "Raise a sexp up a level to unwind a threading form." + (save-excursion + (down-list 2) + (backward-up-list) + (raise-sexp))) + +(defun clojure--nothing-more-to-unwind () + "Return non-nil if a threaded form cannot be unwound further." + (save-excursion + (let ((beg (point))) + (forward-sexp) + (down-list -1) + (backward-sexp 2) ;; the last sexp, the threading macro + (when (looking-back "(\\s-*" (line-beginning-position)) + (backward-up-list)) ;; and the paren + (= beg (point))))) + +(defun clojure--fix-sexp-whitespace (&optional move-out) + "Fix whitespace after unwinding a threading form. + +Optional argument MOVE-OUT, if non-nil, means moves up a list +before fixing whitespace." + (save-excursion + (when move-out (backward-up-list)) + (let ((sexp (bounds-of-thing-at-point 'sexp))) + (clojure-indent-region (car sexp) (cdr sexp)) + (delete-trailing-whitespace (car sexp) (cdr sexp))))) + +;;;###autoload +(defun clojure-unwind () + "Unwind thread at point or above point by one level. +Return nil if there are no more levels to unwind." + (interactive) + (save-excursion + (let ((limit (save-excursion + (beginning-of-defun) + (point)))) + (ignore-errors + (when (looking-at "(") + (forward-char 1) + (forward-sexp 1))) + (search-backward-regexp "([^-]*->" limit) + (if (clojure--nothing-more-to-unwind) + (progn (clojure--pop-out-of-threading) + (clojure--fix-sexp-whitespace) + nil) + (down-list) + (prog1 (cond + ((looking-at "[^-]*->\\_>") (clojure--unwind-first)) + ((looking-at "[^-]*->>\\_>") (clojure--unwind-last))) + (clojure--fix-sexp-whitespace 'move-out)) + t)))) + +;;;###autoload +(defun clojure-unwind-all () + "Fully unwind thread at point or above point." + (interactive) + (while (clojure-unwind))) + +(defun clojure--remove-superfluous-parens () + "Remove extra parens from a form." + (when (looking-at "([^ )]+)") + (delete-pair))) + +(defun clojure--thread-first () + "Thread a nested sexp using ->." + (down-list) + (forward-symbol 1) + (unless (looking-at ")") + (let ((contents (clojure-delete-and-extract-sexp))) + (backward-up-list) + (just-one-space 0) + (save-excursion + (insert contents "\n") + (clojure--remove-superfluous-parens)) + (when (looking-at "\\s-*\n") + (join-line 'following) + (forward-char 1) + (put-text-property (point) (1+ (point)) + 'clojure-thread-line-joined t)) + t))) + +(defun clojure--thread-last () + "Thread a nested sexp using ->>." + (forward-sexp 2) + (down-list -1) + (backward-sexp) + (unless (eq (char-before) ?\() + (let ((contents (clojure-delete-and-extract-sexp))) + (just-one-space 0) + (backward-up-list) + (insert contents "\n") + (clojure--remove-superfluous-parens) + ;; cljr #255 Fix dangling parens + (forward-sexp) + (when (looking-back "^\\s-*\\()+\\)\\s-*" (line-beginning-position)) + (let ((pos (match-beginning 1))) + (put-text-property pos (1+ pos) 'clojure-thread-line-joined t)) + (join-line)) + t))) + +(defun clojure--threadable-p () + "Return non-nil if a form can be threaded." + (save-excursion + (forward-symbol 1) + (looking-at "[\n\r\t ]*("))) + +;;;###autoload +(defun clojure-thread () + "Thread by one more level an existing threading macro." + (interactive) + (ignore-errors + (when (looking-at "(") + (forward-char 1) + (forward-sexp 1))) + (search-backward-regexp "([^-]*->") + (down-list) + (when (clojure--threadable-p) + (prog1 (cond + ((looking-at "[^-]*->\\_>") (clojure--thread-first)) + ((looking-at "[^-]*->>\\_>") (clojure--thread-last))) + (clojure--fix-sexp-whitespace 'move-out)))) + +(defun clojure--thread-all (first-or-last-thread but-last) + "Fully thread the form at point. + +FIRST-OR-LAST-THREAD is \"->\" or \"->>\". + +When BUT-LAST is non-nil, the last expression is not threaded. +Default value is `clojure-thread-all-but-last'." + (save-excursion + (insert-parentheses 1) + (insert first-or-last-thread)) + (while (save-excursion (clojure-thread))) + (when (or but-last clojure-thread-all-but-last) + (clojure-unwind))) + +;;;###autoload +(defun clojure-thread-first-all (but-last) + "Fully thread the form at point using ->. + +When BUT-LAST is non-nil, the last expression is not threaded. +Default value is `clojure-thread-all-but-last'." + (interactive "P") + (clojure--thread-all "-> " but-last)) + +;;;###autoload +(defun clojure-thread-last-all (but-last) + "Fully thread the form at point using ->>. + +When BUT-LAST is non-nil, the last expression is not threaded. +Default value is `clojure-thread-all-but-last'." + (interactive "P") + (clojure--thread-all "->> " but-last)) + +;;; Cycling stuff + +(defcustom clojure-use-metadata-for-privacy nil + "If nil, `clojure-cycle-privacy' will use (defn- f []). +If t, it will use (defn ^:private f [])." + :package-version '(clojure-mode . "5.5.0") + :safe #'booleanp + :type 'boolean) + +;;;###autoload +(defun clojure-cycle-privacy () + "Make public the current private def, or vice-versa. +See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy" + (interactive) + (save-excursion + (ignore-errors (forward-char 7)) + (search-backward-regexp "(defn?\\(-\\| ^:private\\)?\\_>") + (if (match-string 1) + (replace-match "" nil nil nil 1) + (goto-char (match-end 0)) + (insert (if (or clojure-use-metadata-for-privacy + (equal (match-string 0) "(def")) + " ^:private" + "-"))))) + +(defun clojure--convert-collection (coll-open coll-close) + "Convert the collection at (point) by unwrapping it an wrapping it between COLL-OPEN and COLL-CLOSE." + (save-excursion + (while (and + (not (bobp)) + (not (looking-at "(\\|{\\|\\["))) + (backward-char)) + (when (or (eq ?\# (char-before)) + (eq ?\' (char-before))) + (delete-char -1)) + (when (and (bobp) + (not (memq (char-after) '(?\{ ?\( ?\[)))) + (user-error "Beginning of file reached, collection is not found")) + (insert coll-open (substring (clojure-delete-and-extract-sexp) 1 -1) coll-close))) + +;;;###autoload +(defun clojure-convert-collection-to-list () + "Convert collection at (point) to list." + (interactive) + (clojure--convert-collection "(" ")")) + +;;;###autoload +(defun clojure-convert-collection-to-quoted-list () + "Convert collection at (point) to quoted list." + (interactive) + (clojure--convert-collection "'(" ")")) + +;;;###autoload +(defun clojure-convert-collection-to-map () + "Convert collection at (point) to map." + (interactive) + (clojure--convert-collection "{" "}")) + +;;;###autoload +(defun clojure-convert-collection-to-vector () + "Convert collection at (point) to vector." + (interactive) + (clojure--convert-collection "[" "]")) + +;;;###autoload +(defun clojure-convert-collection-to-set () + "Convert collection at (point) to set." + (interactive) + (clojure--convert-collection "#{" "}")) + +(defun clojure--in-string-p () + "Check whether the point is currently in a string." + (nth 3 (syntax-ppss))) + +(defun clojure--goto-if () + "Find the first surrounding if or if-not expression." + (when (clojure--in-string-p) + (while (or (not (looking-at "(")) + (clojure--in-string-p)) + (backward-char))) + (while (not (looking-at "\\((if \\)\\|\\((if-not \\)")) + (condition-case nil + (backward-up-list) + (scan-error (user-error "No if or if-not found"))))) + +;;;###autoload +(defun clojure-cycle-if () + "Change a surrounding if to if-not, or vice-versa. + +See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if" + (interactive) + (save-excursion + (clojure--goto-if) + (cond + ((looking-at "(if-not") + (forward-char 3) + (delete-char 4) + (forward-sexp 2) + (transpose-sexps 1)) + ((looking-at "(if") + (forward-char 3) + (insert "-not") + (forward-sexp 2) + (transpose-sexps 1))))) + +;; TODO: Remove code duplication with `clojure--goto-if'. +(defun clojure--goto-when () + "Find the first surrounding when or when-not expression." + (when (clojure--in-string-p) + (while (or (not (looking-at "(")) + (clojure--in-string-p)) + (backward-char))) + (while (not (looking-at "\\((when \\)\\|\\((when-not \\)")) + (condition-case nil + (backward-up-list) + (scan-error (user-error "No when or when-not found"))))) + +;;;###autoload +(defun clojure-cycle-when () + "Change a surrounding when to when-not, or vice-versa." + (interactive) + (save-excursion + (clojure--goto-when) + (cond + ((looking-at "(when-not") + (forward-char 9) + (delete-char -4)) + ((looking-at "(when") + (forward-char 5) + (insert "-not"))))) + +(defun clojure-cycle-not () + "Add or remove a not form around the current form." + (interactive) + (save-excursion + (condition-case nil + (backward-up-list) + (scan-error (user-error "`clojure-cycle-not' must be invoked inside a list"))) + (if (looking-back "(not ") + (progn + (delete-char -5) + (forward-sexp) + (delete-char 1)) + (insert "(not ") + (forward-sexp) + (insert ")")))) + +;;; let related stuff + +(defvar clojure--let-regexp + "\(\\(when-let\\|if-let\\|let\\)\\(\\s-*\\|\\[\\)" + "Regexp matching let like expressions, i.e. \"let\", \"when-let\", \"if-let\". + +The first match-group is the let expression. + +The second match-group is the whitespace or the opening square +bracket if no whitespace between the let expression and the +bracket.") + +(defun clojure--goto-let () + "Go to the beginning of the nearest let form." + (when (clojure--in-string-p) + (while (or (not (looking-at "(")) + (clojure--in-string-p)) + (backward-char))) + (ignore-errors + (while (not (looking-at clojure--let-regexp)) + (backward-up-list))) + (looking-at clojure--let-regexp)) + +(defun clojure--inside-let-binding-p () + "Return non-nil if point is inside a let binding." + (ignore-errors + (save-excursion + (let ((pos (point))) + (clojure--goto-let) + (re-search-forward "\\[") + (if (< pos (point)) + nil + (forward-sexp) + (up-list) + (< pos (point))))))) + +(defun clojure--beginning-of-current-let-binding () + "Move before the bound name of the current binding. +Assume that point is in the binding form of a let." + (let ((current-point (point))) + (clojure--goto-let) + (search-forward "[") + (forward-char) + (while (> current-point (point)) + (forward-sexp)) + (backward-sexp 2))) + +(defun clojure--previous-line () + "Keep the column position while go the previous line." + (let ((col (current-column))) + (forward-line -1) + (move-to-column col))) + +(defun clojure--prepare-to-insert-new-let-binding () + "Move to right place in the let form to insert a new binding and indent." + (if (clojure--inside-let-binding-p) + (progn + (clojure--beginning-of-current-let-binding) + (newline-and-indent) + (clojure--previous-line) + (indent-for-tab-command)) + (clojure--goto-let) + (search-forward "[") + (backward-up-list) + (forward-sexp) + (down-list -1) + (backward-char) + (if (looking-at "\\[\\s-*\\]") + (forward-char) + (forward-char) + (newline-and-indent)))) + +(defun clojure--sexp-regexp (sexp) + "Return a regexp for matching SEXP." + (concat "\\([^[:word:]^-]\\)" + (mapconcat #'identity (mapcar 'regexp-quote (split-string sexp)) + "[[:space:]\n\r]+") + "\\([^[:word:]^-]\\)")) + +(defun clojure--replace-sexp-with-binding (bound-name init-expr) + "Replace a binding with its bound name in the let form. + +BOUND-NAME is the name (left-hand side) of a binding. + +INIT-EXPR is the value (right-hand side) of a binding." + (save-excursion + (while (re-search-forward + (clojure--sexp-regexp init-expr) + (clojure--point-after 'clojure--goto-let 'forward-sexp) + t) + (replace-match (concat "\\1" bound-name "\\2"))))) + +(defun clojure--replace-sexps-with-bindings (bindings) + "Replace bindings with their respective bound names in the let form. + +BINDINGS is the list of bound names and init expressions." + (let ((bound-name (pop bindings)) + (init-expr (pop bindings))) + (when bound-name + (clojure--replace-sexp-with-binding bound-name init-expr) + (clojure--replace-sexps-with-bindings bindings)))) + +(defun clojure--replace-sexps-with-bindings-and-indent () + "Replace sexps with bindings." + (clojure--replace-sexps-with-bindings + (clojure--read-let-bindings)) + (clojure-indent-region + (clojure--point-after 'clojure--goto-let) + (clojure--point-after 'clojure--goto-let 'forward-sexp))) + +(defun clojure--read-let-bindings () + "Read the bound-name and init expression pairs in the binding form. +Return a list: odd elements are bound names, even elements init expressions." + (clojure--goto-let) + (down-list 2) + (let* ((start (point)) + (sexp-start start) + (end (save-excursion + (backward-char) + (forward-sexp) + (down-list -1) + (point))) + bindings) + (while (/= sexp-start end) + (forward-sexp) + (push + (string-trim (buffer-substring-no-properties sexp-start (point))) + bindings) + (skip-chars-forward "\r\n\t[:blank:]") + (setq sexp-start (point))) + (nreverse bindings))) + +(defun clojure--introduce-let-internal (name &optional n) + "Create a let form, binding the form at point with NAME. + +Optional numeric argument N, if non-nil, introduces the let N +lists up." + (if (numberp n) + (let ((init-expr-sexp (clojure-delete-and-extract-sexp))) + (insert name) + (ignore-errors (backward-up-list n)) + (insert "(let" (clojure-delete-and-extract-sexp) ")") + (backward-sexp) + (down-list) + (forward-sexp) + (insert " [" name " " init-expr-sexp "]\n") + (clojure--replace-sexps-with-bindings-and-indent)) + (insert "[ " (clojure-delete-and-extract-sexp) "]") + (backward-sexp) + (insert "(let " (clojure-delete-and-extract-sexp) ")") + (backward-sexp) + (down-list 2) + (insert name) + (forward-sexp) + (up-list) + (newline-and-indent) + (insert name))) + +(defun clojure--move-to-let-internal (name) + "Bind the form at point to NAME in the nearest let." + (if (not (save-excursion (clojure--goto-let))) + (clojure--introduce-let-internal name) + (let ((contents (clojure-delete-and-extract-sexp))) + (insert name) + (clojure--prepare-to-insert-new-let-binding) + (insert contents) + (backward-sexp) + (insert " ") + (backward-char) + (insert name) + (clojure--replace-sexps-with-bindings-and-indent)))) + +(defun clojure--let-backward-slurp-sexp-internal () + "Slurp the s-expression before the let form into the let form." + (clojure--goto-let) + (backward-sexp) + (let ((sexp (string-trim (clojure-delete-and-extract-sexp)))) + (delete-blank-lines) + (down-list) + (forward-sexp 2) + (newline-and-indent) + (insert sexp) + (clojure--replace-sexps-with-bindings-and-indent))) + +;;;###autoload +(defun clojure-let-backward-slurp-sexp (&optional n) + "Slurp the s-expression before the let form into the let form. +With a numberic prefix argument slurp the previous N s-expression into the let form." + (interactive "p") + (unless n (setq n 1)) + (dotimes (k n) + (save-excursion (clojure--let-backward-slurp-sexp-internal)))) + +(defun clojure--let-forward-slurp-sexp-internal () + "Slurp the next s-expression after the let form into the let form." + (clojure--goto-let) + (forward-sexp) + (let ((sexp (string-trim (clojure-delete-and-extract-sexp)))) + (down-list -1) + (newline-and-indent) + (insert sexp) + (clojure--replace-sexps-with-bindings-and-indent))) + +;;;###autoload +(defun clojure-let-forward-slurp-sexp (&optional n) + "Slurp the next s-expression after the let form into the let form. +With a numeric prefix argument slurp the next N s-expressions into the let form." + (interactive "p") + (unless n (setq n 1)) + (dotimes (k n) + (save-excursion (clojure--let-forward-slurp-sexp-internal)))) + +;;;###autoload +(defun clojure-introduce-let (&optional n) + "Create a let form, binding the form at point. +With a numeric prefix argument the let is introduced N lists up." + (interactive "P") + (clojure--introduce-let-internal (read-from-minibuffer "Name of bound symbol: ") n)) + +;;;###autoload +(defun clojure-move-to-let () + "Move the form at point to a binding in the nearest let." + (interactive) + (clojure--move-to-let-internal (read-from-minibuffer "Name of bound symbol: "))) + + +;;; ClojureScript +(defconst clojurescript-font-lock-keywords + (eval-when-compile + `(;; ClojureScript built-ins + (,(concat "(\\(?:\.*/\\)?" + (regexp-opt '("js-obj" "js-delete" "clj->js" "js->clj")) + "\\>") + 0 font-lock-builtin-face))) + "Additional font-locking for `clojurescript-mode'.") + +;;;###autoload +(define-derived-mode clojurescript-mode clojure-mode "ClojureScript" + "Major mode for editing ClojureScript code. + +\\{clojurescript-mode-map}" + (font-lock-add-keywords nil clojurescript-font-lock-keywords)) + +;;;###autoload +(define-derived-mode clojurec-mode clojure-mode "ClojureC" + "Major mode for editing ClojureC code. + +\\{clojurec-mode-map}") + +;;;###autoload +(progn + (add-to-list 'auto-mode-alist + '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode)) + (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode)) + (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode)) + ;; boot build scripts are Clojure source files + (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode))) + +(provide 'clojure-mode) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; clojure-mode.el ends here |