Browse files

wip - externalization of clojure parser from ccw

  • Loading branch information...
0 parents commit ffa30336d59b04d88fc54a14ea5fa7ebadbb0ba6 @laurentpetit committed Oct 15, 2010
8 .classpath
@@ -0,0 +1,8 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<classpath>
+ <classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER/org.eclipse.jdt.internal.debug.ui.launcher.StandardVMType/J2SE-1.5"/>
+ <classpathentry kind="con" path="org.eclipse.pde.core.requiredPlugins"/>
+ <classpathentry kind="src" path="src"/>
+ <classpathentry exported="true" kind="lib" path="classes" sourcepath="classes"/>
+ <classpathentry kind="output" path="bin"/>
+</classpath>
4 .gitignore
@@ -0,0 +1,4 @@
+bin/
+classes/
+.lein/
+.cake/
34 .project
@@ -0,0 +1,34 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+ <name>ccw.parser.clojure</name>
+ <comment></comment>
+ <projects>
+ </projects>
+ <buildSpec>
+ <buildCommand>
+ <name>ccw.builder</name>
+ <arguments>
+ </arguments>
+ </buildCommand>
+ <buildCommand>
+ <name>org.eclipse.jdt.core.javabuilder</name>
+ <arguments>
+ </arguments>
+ </buildCommand>
+ <buildCommand>
+ <name>org.eclipse.pde.ManifestBuilder</name>
+ <arguments>
+ </arguments>
+ </buildCommand>
+ <buildCommand>
+ <name>org.eclipse.pde.SchemaBuilder</name>
+ <arguments>
+ </arguments>
+ </buildCommand>
+ </buildSpec>
+ <natures>
+ <nature>org.eclipse.jdt.core.javanature</nature>
+ <nature>ccw.nature</nature>
+ <nature>org.eclipse.pde.PluginNature</nature>
+ </natures>
+</projectDescription>
8 .settings/org.eclipse.jdt.core.prefs
@@ -0,0 +1,8 @@
+#Mon Jun 07 14:09:24 CEST 2010
+eclipse.preferences.version=1
+org.eclipse.jdt.core.compiler.codegen.inlineJsrBytecode=enabled
+org.eclipse.jdt.core.compiler.codegen.targetPlatform=1.5
+org.eclipse.jdt.core.compiler.compliance=1.5
+org.eclipse.jdt.core.compiler.problem.assertIdentifier=error
+org.eclipse.jdt.core.compiler.problem.enumIdentifier=error
+org.eclipse.jdt.core.compiler.source=1.5
15 META-INF/MANIFEST.MF
@@ -0,0 +1,15 @@
+Manifest-Version: 1.0
+Bundle-ManifestVersion: 2
+Bundle-Name: Clojure Grammar used by CounterClockwise
+Bundle-SymbolicName: ccw.parser.clojure;singleton:=true
+Bundle-Version: 0.1.0.STABLE01
+Bundle-ClassPath: .,
+ classes/
+Bundle-ActivationPolicy: lazy
+Bundle-Vendor: Laurent Petit
+Require-Bundle: parsley;bundle-version="0.0.0";visibility:=reexport,
+ ccw.clojure;bundle-version="1.2.0",
+ ccw.clojurecontrib;bundle-version="1.2.0"
+Bundle-RequiredExecutionEnvironment: J2SE-1.5
+Export-Package: ccw.parser.clojure
+
5 README
@@ -0,0 +1,5 @@
+WIP - do not use yet -
+The following work is released under the EPL.
+
+It is the Parsley's Clojure source code parser used by the Counterclockwise Eclipse plugin.
+
4 build.properties
@@ -0,0 +1,4 @@
+source.. = src/
+bin.includes = META-INF/,\
+ .,\
+ classes/
7 project.clj
@@ -0,0 +1,7 @@
+(defproject ccw.parser.clojure"0.1.0.STABLE01"
+ :description "Parsley Clojure parser used by the Counterclockwise (aka ccw) Eclipse Plugin"
+ ;:url "http://..."
+ ;:tasks [protobuf.tasks]
+ :dependencies [[clojure "1.2.0"]
+ [clojure-contrib "1.2.0"]
+ [parsley #_"0.0.2.BETA01"]]
222 src/ccw/parser/clojure/core.clj
@@ -0,0 +1,222 @@
+;adaptations paredit pour pouvoir echanger avec parsley:
+;
+; 1. renommer les tags des noeuds: des keywords :atom, :list, etc.
+; 2. virer :end-offset, :offset, :line, :col
+; 3. regler le "pb" du :root ??
+
+
+
+ ; note : hiredman's reader http://github.com/hiredman/clojure/blob/readerII/src/clj/clojure/reader.clj#L516
+; still TODO :
+; 1. done - make parser and function behaviour similar for terminals atom and spaces
+; 1.a (and move the special handling of zipping terminals up on :eof from default-handler to default-maker ?)
+; 2. correctly handle clojure specificities : #{} #^ #"" ' ` @ ^ #' #_ #() ~ ~@ foo# #!
+; 3. correctly handle the premature :eof on non closed structures (a cause of error)
+; 4. correctly handle parsetree errors (wrong closing of bracket (this one done), ... TODO finish the exhaustive list)
+; 5. make the parser restartable
+; 6. make the parser incremental
+; 7. refactor the code so that the handling of advancing offset, line, column ... is mutualized (be aware of not introducing regressions in the handling of atoms and spaces terminals)
+; point 6. is optional :-)
+; point 3. may be viewed as a special case of point 4 ?
+
+; bugs:
+; \newlinb should be an error, not \n + symbol ewlinb
+
+; miscellaneous TODO
+; * add an explicit error message to :parser-state :ko (unbalanced parens)
+
+(ns paredit.parser
+ (:use clojure.test)
+ (:use clojure.contrib.core)
+ (:use paredit.regex-utils)
+ (:require [clojure.zip :as zip])
+ (:require [clojure.contrib.zip-filter :as zf])
+ ;(:require [net.cgrand.parsley.glr :as core] :reload)
+ (:use net.cgrand.parsley :reload)
+ (:require [net.cgrand.parsley.lrplus :as lr+]))
+
+#_(set! *warn-on-reflection* true)
+
+(def *spy?* (atom false))
+(defn start-spy [] (reset! *spy?* true))
+(defn stop-spy [] (reset! *spy?* false))
+
+(defn spy*
+ [msg expr]
+ `(let [expr# ~expr]
+ (do
+ (when @*spy?* (println (str "::::spying[" ~msg "]:::: " '~expr ":::: '" expr# "'")))
+ expr#)))
+
+(defmacro spy
+ ([expr] (spy* "" expr))
+ ([msg expr] (spy* msg expr)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; utility code
+(defn
+ start-like
+ "returns true if s1 is a prefix of s2 or s2 is a prefix of s1.
+ Examples:
+ (= true (start-like \"bar and foo\" \"bar\"))
+ (= true (start-like \"bar\" \"bar and foo\"))
+ (= false (start-like \"bar\" \"baz\"))
+ (= true (start-like \"bar\" \"bar\"))
+ (= true (start-like \"ba\" \"bar\"))
+ (= true (start-like \"bar\" \"ba\"))
+ (= true (start-like \"b\" \"bar\"))
+ (= true (start-like \"bar\" \"b\"))
+ (= true (start-like \"\" \"bar\"))
+ (= true (start-like \"bar\" \"\"))"
+ [^String s1 ^String s2]
+ (or (.startsWith s1 s2) (.startsWith s2 s1))
+ #_(.startsWith s1 (.substring s2 0 (min (.length s2) (.length s1)))))
+
+(deftest test-start-like
+ (testing "start-like"
+ (are [expected s1 s2] (= expected (start-like s1 s2))
+ true "bar and foo" "bar"
+ true "bar" "bar and foo"
+
+ false "bar" "baz"
+ false "baz" "bar"
+
+ true "bar" "bar"
+
+ true "ba" "bar"
+ true "bar" "ba"
+
+ true "bar" "b"
+ true "bar" "b"
+
+ true "bar" ""
+ true "" "bar")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; the parser code
+(def *brackets* {"(" ")", "{" "}", "[" "]", "\"" "\"", "#\"" "\"", "#{" "}", "#(" ")"})
+(def *tag-closing-brackets* {:list ")", :map "}", :vector "]", :string "\"", :regex "\"", :set "}", :fn ")"})
+(def *tag-opening-brackets* {:list "(", :map "{", :vector "[", :string "\"", :regex "#\"", :set "#{", :fn "#("})
+(def *brackets-tags* #{:list :map :vector :string :set :fn :regex})
+(def ^{:private true} *opening-bracket-tags* {"(" :list, "{" :map, "[" :vector, "\"" :string, "#\"" :regex, "#{" :set, "#(" :fn})
+(def *opening-brackets* (set (keys *brackets*)))
+(def *closing-brackets* (set (vals *brackets*)))
+(def *spaces* #{(str \space) (str \tab) (str \newline) (str \return) (str \,)})
+
+(def *atom* #{:symbol :keyword :int :float :ratio :anon-arg})
+
+(def *atoms* (conj *atom* :whitespace))
+
+(defn empty-node? [node]
+ (or
+ (= :whitespace (:tag node))
+ (every? #(and (not (string? %)) (= :whitespace (:tag %))) (:content node))))
+
+(defn char-at
+ "if index is out of bounds, just returns nil"
+ [^String s index]
+ (when (< -1 index (.length s))
+ (.charAt s index)))
+
+(defn eof [s eof?]
+ (when (and (= 0 (.length s)) eof?) [0 eof]))
+
+(defn bracket-end [s eof?]
+ (lr+/match #{")" "]" "}" eof} s eof?))
+
+(def sexp
+ (parser {:root-tag :root
+ :main :expr*
+ :space (unspaced #{:whitespace :comment :discard} :*)}
+ :expr- #{
+ :list
+ :vector
+ :map
+; :odd-map
+ :set
+ :quote
+ :meta
+ :deref
+ :syntax-quote
+ :var
+ :fn
+ :deprecated-meta
+ :unquote-splicing
+ :unquote
+ :string
+ :regex
+ :symbol
+ :keyword
+ :int
+ :float
+ :ratio
+ :anon-arg
+ :char
+ ;:unexpected-close
+ :chimera
+ }
+ :list ["(" :expr* ")"] ;#{")" "]" "}" eof}]
+ :chimera #{ ["(" :expr* #{"]" "}" eof}]
+ ["[" :expr* #{")" "}" eof}]
+ ["{" :expr* #{")" "]" eof}]
+ ["#(" :expr* #{"]" "}" eof}]
+ ["#{" :expr* #{")" "]" eof}]
+ (unspaced \" #"(?:\\.|[^\\\"])++(?!\")" :? eof)
+ (unspaced "#\"" #"(?:\\.|[^\\\"])++(?!\")" :? eof)
+ ;(unspaced \" #"(?:\\.|[^\\\"])*+" eof)
+ }
+ :vector ["[" :expr* "]"] ;#{")" "]" "}" eof}]
+ :map ["{" :expr* "}"] ;#{")" "]" "}" eof}]
+; :map ["{" [:expr :expr]:* "}"]
+ ; :odd-map ["{" [:expr :expr]:* :expr "}"]
+ :set ["#{" :expr* "}"] ;#{")" "]" "}" eof}]
+ :quote [\' :expr]
+ :meta ["^" :expr :expr]
+ :deref [\@ :expr]
+ :syntax-quote [\` :expr]
+ :var ["#'" :expr]
+ :fn ["#(" :expr* ")"]
+ :deprecated-meta ["#^" :expr :expr]
+ :unquote-splicing ["~@" :expr]
+ :unquote [#"~(?!@)" :expr]
+ :string (unspaced \" #"(?:\\.|[^\\\"])++(?=\")" :? \")
+ :regex (unspaced "#\"" #"(?:\\.|[^\\\"])++(?=\")" :? \")
+ :symbol
+ ;#"(?:\.|\/|\&|(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))(?:(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))|[0-9]|\.|\#(?!\()))*(?:\:(?:(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))|[0-9]|\.|\#(?!\()))+)*)(?:\/(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))(?:(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))|[0-9]|\.|\#(?!\()))*(?:\:(?:(?:(?:[a-z|A-Z|\*|\!|\-(?![0-9])|\_|\?|\>|\<|\=|\$]|\+(?![0-9]))|[0-9]|\.|\#(?!\()))+)*))?)"
+ (let [symbol-head
+ #"(?:[a-z|A-Z|\*|\!]|\-(?![0-9])|[\_|\?|\>|\<|\=|\$]|\+(?![0-9]))"
+ ; other characters will be allowed eventually, but not all macro characters have been determined
+ symbol-rest
+ (interpol-regex #"(?:`symbol-head`|[0-9]|\.|\#(?!\())")
+ ; "." : multiple successive points is allowed by the reader (but will break at evaluation)
+ ; "#" : normally # is allowed only in syntax quote forms, in last position
+ symbol-name
+ (interpol-regex #"(?:`symbol-head``symbol-rest`*(?:\:`symbol-rest`++)*+)")
+ ]
+ (interpol-regex #"(?:\.|\/|\&|`symbol-name`(?:\/`symbol-name`)?)"))
+ ;:symbol- #"[:]?([\D&&[^/]].*/)?([\D&&[^/]][^/]*)"
+ ; from old definition of symbol :symbol- #"[\%|\&||\.|\/|.*"
+ :int #"[-+]?(?:0(?!\.)|[1-9][0-9]*+(?!\.)|0[xX][0-9A-Fa-f]++(?!\.)|0[0-7]++(?!\.)|[1-9][0-9]?[rR][0-9A-Za-z]++(?!\.)|0[0-9]++(?!\.))"
+ :ratio #"[-+]?[0-9]++/[0-9]++"
+ :float #"[-+]?[0-9]++\.[0-9]*+(?:[eE][-+]?+[0-9]++)?+M?+"
+ :anon-arg #"%(?:[0-9|\&])?+" ; (?![_|\(])
+ :keyword (unspaced #":{1,2}" #"[^\(\[\{#\'\^\@\`\~\"\\\,\s\;\)\]\}]++")
+ ;:atom #"[a-z|A-Z|0-9|\!|\$|\%|\&|\*|\+|\-|\.|\/|\:|\<|\=|\>|\?|\_][a-z|A-Z|0-9|\!|\$|\%|\&|\*|\+|\-|\.|\/|\:|\<|\=|\>|\?|\_|\#]*"
+ ;:atom #"[a-z|A-Z|0-9|\!|\$|\%|\&|\*|\+|\-|\.|\/|\:|\<|\=|\>|\?|\_].*"
+ ;;;; CAS DU +toto+ -toto-
+ :char #"\\(?:newline|space|tab|backspace|formfeed|return|u[0-9|a-f|A-F]{4}|o[0-3]?+[0-7]{1,2}|.)"
+ :whitespace #"(?:,|\s)++"
+ :comment #"(?:\#\!|;)[^\n]*+"
+ :discard ["#_" :expr]
+ ;:unexpected-close #{#"}" #"\)" #"]"}
+ ))
+
+(defn parse
+ ([^String text]
+ (sexp text))
+ ([^String text offset]
+ (sexp text)))
+
+(defn parse-tree
+ [state]
+ state)
10 src/paredit/compile.clj
@@ -0,0 +1,10 @@
+(ns paredit.compile)
+
+(set! *warn-on-reflection* true)
+
+(defn all []
+ (compile 'paredit.loc-utils)
+ (compile 'paredit.text-utils)
+ (compile 'paredit.parser)
+ (compile 'paredit.core-commands)
+ (compile 'paredit.core))
540 src/paredit/core.clj
@@ -0,0 +1,540 @@
+; todo
+; done 1. emit text deltas, not plain text replacement (or IDEs will not like it)
+; done 2. have a story for invalid parsetrees : just do nothing : currently = paredit deactivated if error from start-of-file to area of paredit's work
+; 3. use restartable version of the parser
+; 4. make paredit optional in ccw
+; 5. prepare a new release of ccw
+; 6. write with clojure.zip functions the close-* stuff
+; 7. write the string related stuff
+; ... ?
+; . add support for more clojure-related source code ( #{}, #""... )
+; ... and all the other paredit stuff ...
+
+(ns paredit.core
+ (:use clojure.contrib.def)
+ (:use [paredit.parser :exclude [pts]])
+ (:use clojure.set)
+ (:use clojure.contrib.core)
+ (:require clojure.contrib.pprint)
+ (:require [clojure.contrib.str-utils2 :as str2])
+ (:require [paredit.text-utils :as t])
+ (:require [clojure.zip :as z])
+ (:use paredit.loc-utils)) ; TODO avoir un require :as l
+
+#_(set! *warn-on-reflection* true)
+
+;;; adaptable paredit configuration
+(def ^String *newline* "\n")
+;;; adaptable paredit configuration
+
+(def *real-spaces* #{(str \newline) (str \tab) (str \space)})
+(def *extended-spaces* (conj *real-spaces* (str \,)))
+(def *open-brackets* (conj #{"(" "[" "{"} nil)) ; we add nil to the list to also match beginning of text
+(def *close-brackets* (conj #{")" "]" "}"} nil)) ; we add nil to the list to also match end of text
+(def *form-macro-chars* #{(str \#) (str \~) "~@" (str \') (str \`) (str \@) "^" "#'" "#_" "#!"})
+(def *not-in-code* #{:string "\"\\" :comment :char :regex})
+
+(defmacro with-memoized [func-names & body]
+ `(binding [~@(mapcat
+ (fn [func-name] [func-name `(memoize ~func-name)])
+ func-names)]
+ ~@body))
+
+(defmacro with-important-memoized [& body]
+ `(with-memoized
+ [start-offset
+ end-offset
+ loc-text
+ loc-col
+ loc-for-offset
+ leave-for-offset
+ loc-containing-offset
+ contains-offset?
+ normalized-selection
+ node-text]
+ ~@body))
+
+(defn normalized-selection
+ "makes a syntaxically correct selection, that is the returned nodes are siblings.
+ returns a vector of 2 locs.
+ If the selection is empty, the first loc will give the start (get it via a call to 'loc-start on it)
+ and the second loc will be nil.
+ If the selection is not empty, the second loc will give the end (get it via a call to 'loc-end on it).
+ Pre-requisites: length >=0, offset >=0. rloc = root loc of the tree"
+ [rloc offset length]
+ (let [left-leave (parse-leave (leave-for-offset rloc offset))
+ right-leave (parse-leave (leave-for-offset rloc (+ offset length)))
+ right-leave (cond
+ (= :root (loc-tag right-leave))
+ (parse-leave (leave-for-offset rloc (dec (+ offset length))))
+ (not= (+ offset length) (start-offset right-leave))
+ (parse-node right-leave)
+ (nil? (seq (previous-leaves right-leave)))
+ (parse-node right-leave)
+ :else
+ (parse-node (first (previous-leaves right-leave))))]
+ (if (or
+ (= [0 0] [offset length])
+ (and
+ (= 0 length)
+ (= (start-offset left-leave) offset))
+ (and
+ (= (start-offset (parse-node left-leave)) offset)
+ (= (end-offset (parse-node right-leave)) (+ offset length))
+ (same-parent? (parse-node left-leave) (parse-node right-leave))))
+ [left-leave (when-not (zero? length) right-leave)]
+ (let [left-leave (parse-node left-leave)
+ right-leave (parse-node right-leave)
+ min-depth (min (loc-depth left-leave) (loc-depth right-leave))
+ left-leave (up-to-depth left-leave min-depth)
+ right-leave (up-to-depth right-leave min-depth)]
+ (first
+ (filter
+ (fn [[l r]] (= (z/up l) (z/up r)))
+ (iterate
+ (fn [[l r]] [(z/up l) (z/up r)])
+ [left-leave right-leave])))))))
+
+(defn parsed-in-tags?
+ [parsed tags-set]
+ (tags-set (-> parsed :parents peek :tag)))
+
+(defn parse-stopped-in-code?
+ ; TODO the current function is not general enough, it just works for the offset
+ ; the parse stopped at
+ "true if character at offset offset is in a code
+ position, e.g. not in a string, regexp, literal char or comment"
+ [parsed]
+ (not (parsed-in-tags? parsed *not-in-code*)))
+
+(defn in-code? [loc] (and loc (not (*not-in-code* (loc-tag (parse-node loc))))))
+
+(defmulti paredit (fn [k & args] k))
+
+(defn insert-balanced
+ [[o c] t chars-with-no-space-before chars-with-no-space-after]
+ (let [add-pre-space? (not (contains? chars-with-no-space-before
+ (t/previous-char-str t 1 #_(count o))))
+ add-post-space? (not (contains? chars-with-no-space-after
+ (t/next-char-str t)))
+ ins-str (str (if add-pre-space? " " "")
+ (str o c)
+ (if add-post-space? " " ""))
+ offset-shift (if add-post-space? -2 -1)]
+ (-> t (t/insert ins-str) (t/shift-offset offset-shift))))
+
+(declare wrap-with-balanced)
+
+(defn open-balanced
+ [parsed [o c] {:keys [^String text offset length] :as t}
+ chars-with-no-space-before chars-with-no-space-after]
+ (if (zero? length)
+ (let [offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))]
+ (if (in-code? offset-loc)
+ (insert-balanced [o c] t chars-with-no-space-before chars-with-no-space-after)
+ (-> t (t/insert (str o)))))
+ (wrap-with-balanced parsed [o c] t)))
+
+(defn close-balanced
+ [parsed [o c] {:keys [^String text offset length] :as t}
+ chars-with-no-space-before chars-with-no-space-after]
+ (let [offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))]
+ (if (in-code? offset-loc)
+ (let [up-locs (take-while identity (iterate z/up offset-loc))
+ match (some #(when (= c (peek (:content (z/node %)))) %) up-locs)]
+ (if match
+ (let [last-loc (-> match z/down z/rightmost z/left)
+ nb-delete (if (= :whitespace (loc-tag last-loc))
+ (loc-count last-loc)
+ 0)
+ t (if (> nb-delete 0)
+ (t/delete t (start-offset last-loc) nb-delete)
+ t)] ; z/left because there is the closing node
+ (-> t (t/set-offset (- (end-offset match) nb-delete))))
+ (-> t (t/insert (str c)))))
+ (-> t (t/insert (str c))))))
+
+(defmethod paredit
+ :paredit-open-round
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized
+ (open-balanced parsed ["(" ")"] t
+ (union (conj (into *real-spaces* *open-brackets*) "#") *form-macro-chars*)
+ (into *extended-spaces* *close-brackets*))))
+
+(defmethod paredit
+ :paredit-open-square
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized (open-balanced parsed ["[" "]"] t
+ (union (into *real-spaces* *open-brackets*) *form-macro-chars*)
+ (into *extended-spaces* *close-brackets*))))
+
+(defmethod paredit
+ :paredit-open-curly
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized (open-balanced parsed ["{" "}"] t
+ (union (conj (into *real-spaces* *open-brackets*) "#") *form-macro-chars*)
+ (into *extended-spaces* *close-brackets*))))
+
+(defmethod paredit
+ :paredit-close-round
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized (close-balanced parsed ["(" ")"] t
+ nil nil)))
+
+(defmethod paredit
+ :paredit-close-square
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized (close-balanced parsed ["[" "]"] t
+ nil nil)))
+
+(defmethod paredit
+ :paredit-close-curly
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized (close-balanced parsed ["{" "}"] t
+ nil nil)))
+
+(defmethod paredit
+ :paredit-doublequote
+ [cmd parsed {:keys [text offset length] :as t}]
+ (with-important-memoized
+ (let [offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))]
+ (cond
+ ;(parse-stopped-in-code? parsed)
+ (in-code? offset-loc)
+ (insert-balanced [\" \"] t ; todo voir si on utilise open balanced ? (mais quid echappement?)
+ (conj (into *real-spaces* *open-brackets*) \#)
+ (into *extended-spaces* *close-brackets*))
+ (not= :string (loc-tag offset-loc))
+ (-> t (t/insert (str \")))
+ (and (= "\\" (t/previous-char-str t)) (not= "\\" (t/previous-char-str t 2)))
+ (-> t (t/insert (str \")))
+ (= "\"" (t/next-char-str t))
+ (t/shift-offset t 1)
+ :else
+ (-> t (t/insert (str \\ \")))))))
+
+(defmethod paredit
+ :paredit-forward-delete
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (if (zero? (count text))
+ t
+ (with-important-memoized
+ (if parsed
+ (let [offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))
+ handled-forms *brackets-tags*
+ in-handled-form (handled-forms (loc-tag offset-loc))
+ open-punct-length (.length (first (:content (z/node offset-loc))))]
+ (cond
+ (and in-handled-form (= offset (start-offset offset-loc)))
+ (t/shift-offset t open-punct-length)
+ (and in-handled-form (= offset (dec (end-offset offset-loc))))
+ (if (> (-> offset-loc z/node :content count) 2)
+ t ; don't move
+ (-> t ; delete the form
+ (t/delete (start-offset offset-loc) (loc-count offset-loc))
+ (t/shift-offset (- open-punct-length))))
+ :else
+ (t/delete t offset 1)))
+ (t/delete t offset 1)))))
+
+(defmethod paredit
+ :paredit-backward-delete
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (if (zero? (count text))
+ t
+ (with-important-memoized
+ (if parsed
+ (let [offset (dec offset)
+ offset-loc (-> parsed parsed-root-loc (loc-for-offset offset))
+ ;_ (println "offset-loc:" (z/node offset-loc))
+ handled-forms *brackets-tags*
+ in-handled-form (handled-forms (loc-tag offset-loc))
+ ;_ (println "in-handled-form:" in-handled-form)
+ ]
+ (cond
+ (and in-handled-form (<= (start-offset offset-loc) offset (+ (start-offset offset-loc) (dec (-> offset-loc z/down loc-count)))))
+ (if (> (-> offset-loc z/node :content count) 2)
+ t ; don't move
+ (do ;(println "delete the form:" (start-offset offset-loc) (loc-count offset-loc))
+ (-> t ; delete the form
+ (t/delete (start-offset offset-loc) (loc-count offset-loc))
+ (t/shift-offset (- (-> offset-loc z/down loc-count))))))
+ (and in-handled-form (= offset (dec (end-offset offset-loc))))
+ (do
+ ;(println "final t:")
+ ;(println (start-offset offset-loc) (loc-count offset-loc))
+ (t/shift-offset t -1))
+ :else
+ (-> t (t/delete offset 1) (t/shift-offset -1))))
+ (-> t (t/delete offset 1) (t/shift-offset -1))))))
+
+(defn indent-column
+ "pre-condition: line-offset is already the starting offset of a line"
+ [root-loc line-offset]
+ (let [loc (loc-for-offset root-loc (dec line-offset))]
+ (if-let [loc (z/left loc)]
+ (loop [loc loc seen-loc nil indent 0]
+ (cond
+ (nil? loc)
+ indent
+ (punct-loc? loc)
+ ; we reached the start of the parent form, indent depending on the form's type
+ (+ (loc-col loc)
+ (loc-count loc)
+ (if (#{"(" "#("} (loc-text loc)) 1 0))
+ (= :whitespace (loc-tag loc))
+ ; we see a space
+ (if (.contains ^String (loc-text loc) "\n")
+ (if seen-loc
+ (+ indent (dec (-> ^String (loc-text loc) (.substring (.lastIndexOf ^String (loc-text loc) "\n")) .length)))
+ (recur (z/left loc) nil 0))
+ (recur (z/left loc) nil (+ indent (-> ^String (loc-text loc) .length))))
+ :else
+ (recur (z/left loc) loc 0)))
+ ; we are at the start of the file !
+ 0)))
+
+(defn text-selection
+ "returns a vector [offset length] from a normalized-selection"
+ [nsel]
+ (let [[l r] nsel
+ offset (start-offset l)
+ length (if (nil? r) 0 (- (end-offset r) offset))]
+ [offset length]))
+
+
+
+(defn sel-match-normalized?
+ "Does the selection denoted by offset and length match l (left) and r (right) locs ?"
+ [offset length [l r]]
+ (if (zero? length)
+ (and (nil? r) (= offset (start-offset l)))
+ (and (= offset (start-offset l)) (= (+ offset length) (end-offset r)))))
+
+(defmethod paredit
+ :paredit-expand-left
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l r] (normalized-selection rloc offset length)
+ l (if (sel-match-normalized? offset length [l r])
+ (if-let [nl (z/left l)] nl (if (punct-loc? l) (z/left (z/up l)) (z/up l)))
+ (do
+ (spy [(z/node l) (and r (z/node r))])
+ (spy "not normalized!" l)))
+ r (if (nil? r) l r)
+ [l r] (normalized-selection rloc (spy (start-offset l)) (spy (- (end-offset r) (start-offset l))))]
+ (spy (-> t (assoc-in [:offset] (start-offset l))
+ (assoc-in [:length] (if (nil? r) 0 (- (end-offset r) (start-offset l)))))))
+ t)))
+
+(defmethod paredit
+ :paredit-expand-up
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l r] (normalized-selection rloc offset length)]
+ (if-not (sel-match-normalized? offset length [l r])
+ (-> t (assoc-in [:offset] (start-offset l))
+ (assoc-in [:length] (if (nil? r) 0 (- (end-offset r) (start-offset l)))))
+ (let [l (if-let [nl (z/up (if (= offset (start-offset (parse-node l)))
+ (parse-node l)
+ (parse-leave l)))]
+ nl
+ l)]
+ (-> t (assoc-in [:offset] (start-offset l))
+ (assoc-in [:length] (- (end-offset l) (start-offset l)))))))
+ t)))
+
+(defmethod paredit
+ :paredit-expand-right
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l r] (normalized-selection rloc offset length)]
+ (if-not (sel-match-normalized? offset length [l r])
+ (-> t (assoc-in [:offset] (start-offset l))
+ (assoc-in [:length] (if (nil? r) 0 (- (end-offset r) (start-offset l)))))
+ (let [r (if (nil? r)
+ l
+ (if-let [nr (z/right r)]
+ nr
+ (z/up r)))
+ [l r] (normalized-selection rloc (spy (start-offset l)) (spy (- (end-offset r) (start-offset l))))]
+ (-> t (assoc-in [:offset] (start-offset l))
+ (assoc-in [:length] (if (nil? r) 0 (- (end-offset r) (start-offset l))))))))
+ t)))
+
+(defmethod paredit
+ :paredit-raise-sexp
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l r] (normalized-selection rloc offset length)]
+ (if-not (and
+ (sel-match-normalized? offset length [l r])
+ (= offset (start-offset (parse-node l))))
+ t
+ (let
+ [to-raise-offset (start-offset l)
+ to-raise-length (- (if r (end-offset r) (end-offset (parse-node l))) (start-offset l))
+ to-raise-text (.substring text to-raise-offset (+ to-raise-offset to-raise-length))
+ l (if-let [nl (z/up (parse-node l))] nl l)
+ replace-offset (start-offset l)
+ replace-length (- (end-offset l) replace-offset)]
+ (-> t (assoc-in [:text] (t/str-replace text replace-offset replace-length to-raise-text))
+ (assoc-in [:offset] replace-offset)
+ (assoc-in [:length] 0)
+ (update-in [:modifs] conj {:offset replace-offset :length replace-length :text to-raise-text})))))
+ t)))
+
+(defmethod paredit
+ :paredit-split-sexp
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized (if (not= 0 length)
+ t
+ (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l r] (normalized-selection rloc offset length)
+ parent (cond
+ (= :string (loc-tag l)) l ; stay at the same level, and let the code take the correct open/close puncts, e.g. \" \"
+ :else (if-let [nl (z/up (if (start-punct? l) (parse-node l) (parse-leave l)))] nl (parse-leave l)))
+ open-punct (*tag-opening-brackets* (loc-tag parent))
+ close-punct ^String (*tag-closing-brackets* (loc-tag parent))]
+ (if-not close-punct
+ t
+ (let [replace-text (str close-punct " " open-punct)
+ [replace-offset
+ replace-length] (if (and
+ (not= :whitespace (loc-tag l))
+ (or
+ (= :string (loc-tag l))
+ (not (and
+ (sel-match-normalized? offset length [l r])
+ (= offset (start-offset (parse-node l)))))))
+ [offset 0]
+ (let [start (or (some #(when-not (= :whitespace (loc-tag %)) (end-offset %)) (previous-leaves l)) offset)
+ end (or (some #(when-not (= :whitespace (loc-tag %)) (start-offset %)) (next-leaves l)) 0)]
+ [start (- end start)]))
+ new-offset (+ replace-offset (.length close-punct))]
+ (-> t (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
+ (assoc-in [:offset] new-offset)
+ (update-in [:modifs] conj {:offset replace-offset :length replace-length :text replace-text})))))
+ t))))
+
+(defmethod paredit
+ :paredit-join-sexps
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized
+ (if (not= 0 length)
+ t
+ (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [[l _] (normalized-selection rloc offset length)
+ lf (first (remove #(= :whitespace (loc-tag %)) (previous-leaves l)))
+ rf (first (remove #(= :whitespace (loc-tag %)) (cons l (next-leaves l))))]
+ (if (or (nil? lf) (nil? rf) (start-punct? lf) (end-punct? rf))
+ t
+ (let [ln (parse-node lf)
+ rn (parse-node rf)]
+ (if-not (and
+ (= (loc-tag ln) (loc-tag rn)))
+ t
+ (let [replace-offset (- (end-offset ln) (if-let [punct ^String (*tag-closing-brackets* (loc-tag ln))] (.length punct) 0))
+ replace-length (- (+ (start-offset rn) (if-let [punct ^String (*tag-closing-brackets* (loc-tag rn))] (.length punct) 0)) replace-offset)
+ replace-text (if ((conj *atom* :string) (loc-tag ln)) "" " ")
+ new-offset (if (= offset (start-offset rn)) (+ replace-offset (.length replace-text)) replace-offset)]
+ (-> t (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
+ (assoc-in [:offset] new-offset)
+ (update-in [:modifs] conj {:offset replace-offset :length replace-length :text replace-text})))))))
+ t))))
+
+(defn wrap-with-balanced
+ [parsed [^String o c] {:keys [^String text offset length] :as t}]
+ (let [bypass #(-> t
+ (update-in [:text] t/str-replace offset length o)
+ (update-in [:offset] + (.length o))
+ (assoc-in [:length] 0)
+ (update-in [:modifs] conj {:text o :offset offset :length length}))]
+ (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [left-leave (some (fn [l] (when (not= :whitespace (loc-tag l)) l)) (next-leaves (leave-for-offset rloc offset)))
+ right-leave (some (fn [l] (when (not= :whitespace (loc-tag l)) l)) (previous-leaves (leave-for-offset rloc (+ offset length))))
+ right-leave (if (or (nil? right-leave) (<= (start-offset right-leave) (start-offset left-leave))) left-leave right-leave)]
+ (if (or
+ (not (in-code? (loc-containing-offset rloc offset)))
+ (not (in-code? (loc-containing-offset rloc (+ offset length))))
+ (> offset (start-offset left-leave))
+ (and (not= 0 length) (or (< (+ offset length) (end-offset right-leave))
+ (not= (z/up (loc-parse-node left-leave)) (z/up (loc-parse-node right-leave))))))
+ (bypass)
+ (let [text-to-wrap (.substring text (start-offset (z/up left-leave)) (end-offset (z/up right-leave)))
+ new-text (str o text-to-wrap c)
+ t (update-in t [:text] t/str-replace (start-offset left-leave) (.length text-to-wrap) new-text)
+ t (assoc-in t [:offset] (inc (start-offset left-leave)))]
+ (update-in t [:modifs] conj {:text new-text :offset (start-offset left-leave) :length (.length text-to-wrap)}))))
+ (bypass))))
+
+(defmethod paredit
+ :paredit-wrap-square
+ [cmd parsed t]
+ (with-important-memoized (wrap-with-balanced parsed ["[" "]"] t)))
+
+(defmethod paredit
+ :paredit-wrap-curly
+ [cmd parsed t]
+ (with-important-memoized (wrap-with-balanced parsed ["{" "}"] t)))
+
+(defmethod paredit
+ :paredit-wrap-round
+ [cmd parsed t]
+ (with-important-memoized (wrap-with-balanced parsed ["(" ")"] t)))
+
+(defmethod paredit
+ :paredit-newline
+ [cmd parsed {:keys [text offset length] :as t}]
+ ; no call to with-important-memoized because we almost immediately delegate to :paredit-indent-line
+ (let [r (paredit :paredit-indent-line
+ (parse (t/str-insert text offset "\n")) ; TODO suppress (or optimize) this call, if possible
+ {:text (t/str-insert text offset "\n")
+ :offset (inc offset)
+ :length length
+ :modifs [{:text *newline* :offset offset :length 0}]})]
+ (if (-?> r :modifs count (= 2))
+ (let [m1 (get-in r [:modifs 0])
+ m2 (get-in r [:modifs 1])
+ r (assoc-in r [:modifs] [{:text (str (:text m1) (:text m2)) :offset offset :length (+ (:length m1) (:length m2))}])
+ r (assoc-in r [:offset] (+ (.length ^String (get-in r [:modifs 0 :text])) offset))]
+ r)
+ r)))
+
+(defmethod paredit
+ :paredit-indent-line
+ [cmd parsed {:keys [^String text offset length] :as t}]
+ (with-important-memoized
+ (if-let [rloc (-?> parsed (parsed-root-loc true))]
+ (let [line-start (spy (t/line-start (spy text) (spy offset)))
+ line-stop (t/line-stop text offset)
+ loc (loc-for-offset rloc line-start)]
+ (if (and (= :string (loc-tag loc)) (< (start-offset loc) line-start))
+ t
+ (let [indent (indent-column rloc line-start)
+ cur-indent-col (-
+ (loop [o line-start]
+ (if (>= o (.length text))
+ o
+ (let [c (.charAt text o)]
+ (cond
+ (#{\return \newline} c) o ; test CR/LF before .isWhitespace !
+ (Character/isWhitespace c) (recur (inc o))
+ (= \, c) (recur (inc o))
+ :else o))))
+ line-start)
+ to-add (- indent cur-indent-col)]
+ (cond
+ (zero? to-add) t
+ :else (let [t (update-in t [:modifs] conj {:text (str2/repeat " " indent) :offset line-start :length cur-indent-col})
+ t (update-in t [:text] t/str-replace line-start cur-indent-col (str2/repeat " " indent))]
+ (cond
+ (>= offset (+ line-start cur-indent-col))
+ (update-in t [:offset] + to-add)
+ (<= offset (+ line-start indent))
+ t
+ :else
+ (update-in t [:offset] + (max to-add (- line-start
+ offset)))))))))
+ t)))
619 src/paredit/core_commands.clj
@@ -0,0 +1,619 @@
+(ns paredit.core-commands
+ (:use clojure.contrib.def))
+
+#_(set! *warn-on-reflection* true)
+
+;;; -*- Mode: Emacs-Lisp; outline-regexp: "\n;;;;+" -*-
+
+;;;;;; Paredit: Parenthesis-Editing Minor Mode
+;;;;;; Version 21
+
+;;; Copyright (c) 2008, Taylor R. Campbell
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;;
+;;; * Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in
+;;; the documentation and/or other materials provided with the
+;;; distribution.
+;;;
+;;; * Neither the names of the authors nor the names of contributors
+;;; may be used to endorse or promote products derived from this
+;;; software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; This file is permanently stored at
+;;; <http://mumble.net/~campbell/emacs/paredit-21.el>.
+;;;
+;;; The currently released version of paredit is available at
+;;; <http://mumble.net/~campbell/emacs/paredit.el>.
+;;;
+;;; The latest beta version of paredit is available at
+;;; <http://mumble.net/~campbell/emacs/paredit-beta.el>.
+;;;
+;;; Release notes are available at
+;;; <http://mumble.net/~campbell/emacs/paredit.release>.
+
+;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
+;;; directory of your choice, and adding to your .emacs file:
+;;;
+;;; (add-to-list 'load-path "/path/to/elisp")
+;;; (autoload 'paredit-mode "paredit"
+;;; "Minor mode for pseudo-structurally editing Lisp code."
+;;; t)
+;;;
+;;; Toggle Paredit Mode with `M-x paredit-mode RET', or enable it
+;;; always in a major mode `M' (e.g., `lisp' or `scheme') with:
+;;;
+;;; (add-hook M-mode-hook (lambda () (paredit-mode +1)))
+;;;
+;;; Customize paredit using `eval-after-load':
+;;;
+;;; (eval-after-load 'paredit
+;;; '(progn ...redefine keys, &c....))
+;;;
+;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5 or
+;;; later. Paredit is highly unlikely to work in earlier versions of
+;;; GNU Emacs, and it may have obscure problems in earlier versions of
+;;; XEmacs due to the way its syntax parser reports conditions, as a
+;;; result of which the code that uses the syntax parser must mask all
+;;; error conditions, not just those generated by the syntax parser.
+;;;
+;;; Questions, bug reports, comments, feature suggestions, &c., may be
+;;; addressed via email to the author's surname at mumble.net or via
+;;; IRC to the user named Riastradh on irc.freenode.net in the #paredit
+;;; channel.
+;;;
+;;; Please contact the author rather than forking your own versions, to
+;;; prevent the dissemination of random variants floating about the
+;;; internet unbeknownst to the author. Laziness is not an excuse:
+;;; your laziness costs me confusion and time trying to support
+;;; paredit, so if you fork paredit, you make the world a worse place.
+;;;
+;;; *** WARNING *** IMPORTANT *** DO NOT SUBMIT BUGS BEFORE READING ***
+;;;
+;;; If you plan to submit a bug report, where some sequence of keys in
+;;; Paredit Mode, or some sequence of paredit commands, doesn't do what
+;;; you wanted, then it is helpful to isolate an example in a very
+;;; small buffer, and it is **ABSOLUTELY**ESSENTIAL** that you supply,
+;;; along with the sequence of keys or commands,
+;;;
+;;; (1) the version of Emacs,
+;;; (2) the version of paredit.el[*], and
+;;; (3) the **COMPLETE** state of the buffer used to reproduce the
+;;; problem, including major mode, minor modes, local key
+;;; bindings, entire contents of the buffer, leading line breaks
+;;; or spaces, &c.
+;;;
+;;; It is often extremely difficult to reproduce problems, especially
+;;; with commands like `paredit-kill'. If you do not supply **ALL** of
+;;; this information, then it is highly probable that I cannot
+;;; reproduce your problem no matter how hard I try, and the effect of
+;;; submitting a bug without this information is only to waste your
+;;; time and mine. So, please, include all of the above information.
+;;;
+;;; [*] If you are using a beta version of paredit, be sure that you
+;;; are using the *latest* edition of the beta version, available
+;;; at <http://mumble.net/~campbell/emacs/paredit-beta.el>. If you
+;;; are not using a beta version, then upgrade either to that or to
+;;; the latest release version; I cannot support older versions,
+;;; and I can't fathom any reason why you might be using them. So
+;;; the answer to item (2) should be either `release' or `beta'.
+
+;;; The paredit minor mode, Paredit Mode, binds a number of simple
+;;; keys, notably `(', `)', `"', and `\', to commands that more
+;;; carefully insert S-expression structures in the buffer. The
+;;; parenthesis delimiter keys (round or square) are defined to insert
+;;; parenthesis pairs and move past the closing delimiter,
+;;; respectively; the double-quote key is multiplexed to do both, and
+;;; also to insert an escape if within a string; and backslashes prompt
+;;; the user for the next character to input, because a lone backslash
+;;; can break structure inadvertently. These all have their ordinary
+;;; behaviour when inside comments, and, outside comments, if truly
+;;; necessary, you can insert them literally with `C-q'.
+;;;
+;;; The key bindings are designed so that when typing new code in
+;;; Paredit Mode, you can generally use exactly the same keystrokes as
+;;; you would have used without Paredit Mode. Earlier versions of
+;;; paredit.el did not conform to this, because Paredit Mode bound `)'
+;;; to a command that would insert a newline. Now `)' is bound to a
+;;; command that does not insert a newline, and `M-)' is bound to the
+;;; command that inserts a newline. To revert to the former behaviour,
+;;; add the following forms to an `eval-after-load' form for paredit.el
+;;; in your .emacs file:
+;;;
+;;; (define-key paredit-mode-map (kbd ")")
+;;; 'paredit-close-round-and-newline)
+;;; (define-key paredit-mode-map (kbd "M-)")
+;;; 'paredit-close-round)
+;;;
+;;; Paredit Mode also binds the usual keys for deleting and killing, so
+;;; that they will not destroy any S-expression structure by killing or
+;;; deleting only one side of a parenthesis or quote pair. If the
+;;; point is on a closing delimiter, `DEL' will move left over it; if
+;;; it is on an opening delimiter, `C-d' will move right over it. Only
+;;; if the point is between a pair of delimiters will `C-d' or `DEL'
+;;; delete them, and in that case it will delete both simultaneously.
+;;; `M-d' and `M-DEL' kill words, but skip over any S-expression
+;;; structure. `C-k' kills from the start of the line, either to the
+;;; line's end, if it contains only balanced expressions; to the first
+;;; closing delimiter, if the point is within a form that ends on the
+;;; line; or up to the end of the last expression that starts on the
+;;; line after the point.
+;;;
+;;; The behaviour of the commands for deleting and killing can be
+;;; overridden by passing a `C-u' prefix argument: `C-u DEL' will
+;;; delete a character backward, `C-u C-d' will delete a character
+;;; forward, and `C-u C-k' will kill text from the point to the end of
+;;; the line, irrespective of the S-expression structure in the buffer.
+;;; This can be used to fix mistakes in a buffer, but should generally
+;;; be avoided.
+;;;
+;;; Paredit performs automatic reindentation as locally as possible, to
+;;; avoid interfering with custom indentation used elsewhere in some
+;;; S-expression. Only the advanced S-expression manipulation commands
+;;; automatically reindent, and only the forms that were immediately
+;;; operated upon (and their subforms).
+;;;
+;;; This code is written for clarity, not efficiency. It frequently
+;;; walks over S-expressions redundantly. If you have problems with
+;;; the time it takes to execute some of the commands, let me know, but
+;;; first be sure that what you're doing is reasonable: it is
+;;; preferable to avoid immense S-expressions in code anyway.
+
+;;; This assumes Unix-style LF line endings.
+
+(defmacro defconst [& body] `(clojure.contrib.def/defvar ~@body))
+
+(defconst paredit-version 21)
+(defconst paredit-beta-p nil)
+
+(defvar
+ paredit-mode-map {}
+ "Keymap for the paredit minor mode.")
+
+(defn check-parens "TODO LAP: implement it !" [text] true)
+(defn can-enable-paredit? [text] (check-parens text))
+
+(def
+ ^{ :doc "
+ The format for documenting the commands is simple, and a slight varation of
+ the original paredit.el format :
+ paredit-commands := [ group* ]
+ group := [ group-name-str command* ]
+ command := [ default-triggering-keys
+ command-name-keyword
+ { before-after-documentation-pair* }
+ { before-after-non-regression-pair* }* ]
+ before-after-documentation-pair := before-after-non-regression-pair
+ before-after-non-regression-pair := before-text-spec after-text-spec
+ before-text-spec := after-text-spec := text-spec
+ text-spec := a string, with the caret position indicated by a pipe character |,
+ and if there is a selected portion of the text, the end of the text
+ selection is marked with another pipe character |"}
+ *paredit-commands*
+ [
+ ["Basic Insertion Commands"
+ ["(" :paredit-open-round
+ {"(a b |c d)"
+ "(a b (|) c d)"
+ "(foo \"bar |baz\" quux)" "(foo \"bar (|baz\" quux)"
+ }
+ {"(a b|c d)" "(a b (|) c d)"
+ "(|)" "((|))"
+ "|" "(|)"
+ "a|" "a (|)"
+ "(a |,b)" "(a (|),b)"
+ "(a,| b)" "(a, (|) b)"
+ "(a,|b)" "(a, (|) b)"
+ "(a,|)" "(a, (|))"
+ "\\| " "\\(| "
+ "~|" "~(|)"
+ "~@|" "~@(|)"
+ "\\\\| " "\\\\ (|) "
+ }]
+ [")" :paredit-close-round
+ {"(a |b)" "(a b)|"
+ "(a |b) cd" "(a b)| cd"
+ "(a |b ) cd" "(a b)| cd"
+ "(a b |c [])" "(a b c [])|"
+ "(a b c [|] )" "(a b c [])|"
+ "(a b |c )" "(a b c)|"
+ "( a, b |[a b ] )" "( a, b [a b ])|"
+ "( a, b [|a b ] )" "( a, b [a b ])|"
+ "[ a, b (|a b ) ]" "[ a, b (a b)| ]"
+ "(a b |c , )" "(a b c)|"
+ "(a b| [d e]" "(a b)| [d e]"
+ "; Hello,| world!" "; Hello,)| world!"
+ "( \"Hello,| world!\" foo )" "( \"Hello,)| world!\" foo )"
+ " \"Hello,| world!" " \"Hello,)| world!"
+ "foo \\|" "foo \\)|"
+ ; tests with the new :chimera
+ "({foo |bar])" "({foo bar])|"
+ "({[foo |bar)})" "({[foo bar)|})"
+ }]
+ #_["M-)" :paredit-close-round-and-newline
+ {"(defun f (x| ))"
+ "(defun f (x)\n |)"
+ "; (Foo.|"
+ "; (Foo.)|"}]
+ ["[" :paredit-open-square
+ {"(a b |c d)" "(a b [|] c d)"
+ "(foo \"bar |baz\" quux)" "(foo \"bar [|baz\" quux)"
+ }
+ {"(a b|c d)" "(a b [|] c d)"
+ "(|)" "([|])"
+ "|" "[|]"
+ "a|" "a [|]"
+ "(a |,b)" "(a [|],b)"
+ "(a,| b)" "(a, [|] b)"
+ "(a,|b)" "(a, [|] b)"
+ "(a,|)" "(a, [|])"
+ "\\| " "\\[| "
+ "\\\\| " "\\\\ [|] "}]
+ ["]" :paredit-close-square
+ {"(define-key keymap [frob| ] 'frobnicate)"
+ "(define-key keymap [frob]| 'frobnicate)"
+ "; [Bar.|" "; [Bar.]|"
+ " \"Hello,| world!\" foo" " \"Hello,]| world!\" foo"
+ " \"Hello,| world!" " \"Hello,]| world!"
+ "foo \\|" "foo \\]|"
+ ; tests with the new :chimera
+ "({foo |bar])" "({foo bar]|)"
+ "({(foo |bar]))" "({(foo bar]|))"
+ "({[foo |bar)})" "({[foo ]|bar)})"
+ "[foo (bar [baz {bleh |blah}))]" "[foo (bar [baz {bleh blah}))]|"
+ }]
+ ["{" :paredit-open-curly
+ {"(a b |c d)" "(a b {|} c d)"
+ "(foo \"bar |baz\" quux)" "(foo \"bar {|baz\" quux)"
+ }
+ {"(a b|c d)" "(a b {|} c d)"
+ "(|)" "({|})"
+ "|" "{|}"
+ "a|" "a {|}"
+ "#|" "#{|}" ; specific to clojure sets
+ "(a |,b)" "(a {|},b)"
+ "(a,| b)" "(a, {|} b)"
+ "(a,|b)" "(a, {|} b)"
+ "(a,|)" "(a, {|})"
+ "\\| " "\\{| "
+ "\\\\| " "\\\\ {|} "
+ }]
+ ["}" :paredit-close-curly
+ {"{a b |c }" "{a b c}|"
+ "; Hello,| world!"
+ "; Hello,}| world!"
+ " \"Hello,| world!\" foo" " \"Hello,}| world!\" foo"
+ " \"Hello,| world!" " \"Hello,}| world!"
+ "foo \\|" "foo \\}|"
+ "({(foo |bar}))" "({(foo bar}|))"
+ }]
+ ["\"" :paredit-doublequote
+ { "(frob grovel |full lexical)" "(frob grovel \"|\" full lexical)",
+ "(frob grovel \"|\" full lexical)" "(frob grovel \"\"| full lexical)",
+ "(foo \"bar |baz\" quux)" "(foo \"bar \\\"|baz\" quux)",
+ ";|ab" ";\"|ab",
+ "(frob grovel \"foo \\|bar\" full lexical)"
+ "(frob grovel \"foo \\\"|bar\" full lexical)",
+ "(frob grovel \"foo \\\\|bar\" full lexical)"
+ "(frob grovel \"foo \\\\\\\"|bar\" full lexical)",
+ "\"fo\\\"o\" \"b|ar\"" "\"fo\\\"o\" \"b\\\"|ar\"",
+ "\"\\\\\" \"b|ar\"" "\"\\\\\" \"b\\\"|ar\"",
+ "\"\\\\\\\"|a\"" "\"\\\\\\\"\\\"|a\"",
+ "\"fo|o\"" "\"fo\\\"|o\"",
+ ;"#\"fo|o\"" "#\"fo\\\"|o\"",
+ ;;;"#\"foo\"" "#\"foo\""
+
+ ;; "#|" "#\"|\"" ; specific to clojure regexs
+
+ }]
+ ]
+ ["Deleting & Killing"
+ ["Del" :paredit-forward-delete
+ {"(quu|x \"zot\")" "(quu| \"zot\")",
+ "(quux |\"zot\")" "(quux \"|zot\")",
+ "(quux \"|zot\")" "(quux \"|ot\")",
+ "(foo |(a) bar)" "(foo (|a) bar)"
+ "(foo (|a) bar)" "(foo (|) bar)"
+ "(foo (|) bar)" "(foo | bar)"
+ "(foo [|] bar)" "(foo | bar)"
+ "(foo {|} bar)" "(foo | bar)"
+ "(foo \"|\" bar)" "(foo | bar)"
+ "(foo (a|) bar)" "(foo (a|) bar)"
+ "(foo [a|] bar)" "(foo [a|] bar)"
+ "(foo {a|} bar)" "(foo {a|} bar)"
+
+ "(foo #{|} bar)" "(foo | bar)"
+ "(foo #{a|} bar)" "(foo #{a|} bar)"
+ "(foo #{a |d} bar)" "(foo #{a |} bar)"
+ "(|#{foo bar})" "(#{|foo bar})"
+
+ "(foo #(|) bar)" "(foo | bar)"
+ "(foo #(a|) bar)" "(foo #(a|) bar)"
+ "(foo #(a |d) bar)" "(foo #(a |) bar)"
+ "(|#(foo bar))" "(#(|foo bar))"
+
+ "(foo #\"|\" bar)" "(foo | bar)"
+ "(foo #\"a|\" bar)" "(foo #\"a|\" bar)"
+ "(foo #\"a |d\" bar)" "(foo #\"a |\" bar)"
+ "(|#\"foo bar\")" "(#\"|foo bar\")"
+
+ "(foo \"a|\" bar)" "(foo \"a|\" bar)"
+ "(|(foo bar))" "((|foo bar))"
+ "(|[foo bar])" "([|foo bar])"
+ "(|{foo bar})" "({|foo bar})"
+
+ "|" "|"
+ }]
+ ["BackDel" :paredit-backward-delete
+ {
+ "(\"zot\" q|uux)" "(\"zot\" |uux)",
+ "(\"zot\"| quux)" "(\"zot|\" quux)",
+ "(\"zot|\" quux)" "(\"zo|\" quux)",
+
+ "(#\"zot\"| quux)" "(#\"zot|\" quux)",
+ "(#\"zot|\" quux)" "(#\"zo|\" quux)",
+
+ "(foo (|) bar)" "(foo | bar)",
+ "(foo #(|) bar)" "(foo | bar)",
+ "(foo #{|} bar)" "(foo | bar)",
+
+ "(foo bar)|" "(foo bar|)",
+ "(foo bar|)" "(foo ba|)",
+
+ "|" "|"
+
+ "\"\"|" "\"|\""
+ "\"|\"" "|"
+ "#\"\"|" "#\"|\""
+ "#\"|\"" "|"
+
+ "#(foo bar)|" "#(foo bar|)",
+ "#(foo bar|)" "#(foo ba|)",
+ "#{foo bar}|" "#{foo bar|}",
+ "#{foo bar|}" "#{foo ba|}",
+ "#(|)" "|",
+ "#{|}" "|"
+ }]
+ ;#_["C-k" :paredit-kill
+ ; {"(foo bar)| ; Useless comment!"
+ ; "(foo bar)|",
+ ; "(|foo bar) ; Useful comment!"
+ ; "(|) ; Useful comment!",
+ ; "|(foo bar) ; Useless line!"
+ ; "|",
+ ; "(foo \"|bar baz\"\n quux)"
+ ; "(foo \"|\"\n quux)"}]
+ ]
+
+ ["Depth-Changing Commands"
+ ["M-(" :paredit-wrap-round
+ {"(foo |bar baz)" "(foo (|bar) baz)",
+ ";hel|lo" ";hel(|lo",
+ "a |\"hi\"" "a (|\"hi\")",
+ "a |\"hi\"|" "a (|\"hi\"|)",
+ "foo |bar| foo" "foo (|bar|) foo",
+ "foo |bar baz| foo" "foo (|bar baz|) foo",
+ "foo (|bar| baz) foo" "foo ((|bar|) baz) foo"
+ "foo (|bar baz|) foo" "foo ((|bar baz|)) foo"
+ ;; not-yet "foo |(bar| baz) foo" "foo |(bar| baz) foo"
+ ;; not-yet "foo (bar| baz)| foo" "foo (bar| baz)| foo"
+ "foo |(bar baz)| foo" "foo (|(bar baz)|) foo"
+ "foo |(bar\n;comment\n baz)| foo" "foo (|(bar\n;comment\n baz)|) foo"
+ ;; not-yet "foo |bar ba|z foo" "foo |bar ba|z foo",
+ "foo \"|bar ba|z\" foo" "foo \"(|z\" foo",
+ ;; not-yet "foo |\"bar ba|z\" foo" "foo |\"bar ba|z\" foo",
+ "foo |bar|" "foo (|bar|)"
+ "foo |(bar)|" "foo (|(bar)|)"
+ }]
+ ;["M-s" :paredit-splice-sexp
+ ; {"(foo (bar| baz) quux)"
+ ; "(foo bar| baz quux)"}]
+ ;[("M-<up>" "ESC <up>")
+ ; paredit-splice-sexp-killing-backward
+ ; ("(foo (let ((x 5)) |(sqrt n)) bar)"
+ ; "(foo (sqrt n) bar)")]
+ ;(("M-<down>" "ESC <down>")
+ ; paredit-splice-sexp-killing-forward
+ ; ("(a (b c| d e) f)"
+ ; "(a b c f)"))
+ ["M-r" :paredit-raise-sexp
+ {"(dynamic-wind in (lambda () |body|) out)" "(dynamic-wind in |body out)"
+ "(dynamic-wind in |body| out)" "|body"
+ "(foo bar|)" "(foo bar|)"
+ "(foo |bar)" "|bar"
+ "(foo |(bar))" "|(bar)"
+ "(foo |(bar]|)" "|(bar]"
+ }]
+ ]
+
+ ["Selection"
+ ["Shift+Alt+Left" :paredit-expand-left
+ {
+ "foo bar| baz" "foo |bar| baz"
+ "foo bar |baz" "foo bar| |baz"
+ "foo ba|r baz" "foo |bar| baz"
+ "foo1 bar b|a|z" "foo1 bar |baz|"
+ "foo2 bar ba|z|" "foo2 bar |baz|"
+ "foo3 bar |baz|" "foo3 bar| baz|"
+ "foo bar| baz|" "foo |bar baz|"
+ "foo |bar baz|" "foo| bar baz|"
+ "|(foo bar baz)|" "|(foo bar baz)|"
+ ;;not-yet "|fo|o bar baz" "|foo bar baz|"
+ ;;not-yet "|foo| bar baz" "|foo bar baz|"
+ ;;not-yet "|foo |bar baz" "|foo bar baz|"
+ ;;not-yet "|foo b|ar baz" "|foo bar baz|"
+ "foo (bar| baz)" "foo (|bar| baz)"
+ "foo b|ar| baz" "foo |bar| baz"
+ "foo1 (|bar| baz)" "foo1 |(bar baz)|"
+ "foo \"bar |baz\"" "foo |\"bar baz\"|"
+ "foo;ba|r\nbaz" "foo|;bar|\nbaz"
+ "foo (bar [ba|z] |foo)" "foo (bar |[baz] |foo)"
+ "foo (bar [ba|z]) (foo [bar (b|az)])" "foo |(bar [baz]) (foo [bar (baz)])|"
+ "foo |(bar [baz (b|am)])" "foo |(bar [baz (bam)])|"
+ "(foo bar|)" "(foo |bar|)"
+ "fooz foo |(bar)| baz" "fooz foo| (bar)| baz"
+ "fooz foo| (bar)| baz" "fooz |foo (bar)| baz"
+ ;with :chimera
+ "(foo bar|]" "(foo |bar|]"
+ "(foo {bar)|]" "(foo |{bar)|]"
+ }]
+ ["Shift+Alt+Right" :paredit-expand-right
+ {
+ "foo bar| baz" "foo bar| |baz"
+ "foo4 bar |baz" "foo4 bar |baz|"
+ "foo ba|r baz" "foo |bar| baz"
+ "foo5 bar b|a|z" "foo5 bar |baz|"
+ "foo6 bar ba|z|" "foo6 bar |baz|"
+ ;;not-yet "foo bar |baz|" "|foo bar baz|"
+ ;;not-yet "foo bar| baz|" "|foo bar baz|"
+ ;;not-yet "foo |bar baz|" "|foo bar baz|"
+ "|foo bar baz" "|foo| bar baz";;
+ "|f|oo bar baz" "|foo| bar baz"
+ "|foo| bar baz" "|foo |bar baz"
+ "|foo |bar baz" "|foo bar| baz"
+ "|foo b|ar baz" "|foo bar| baz"
+ "foo (bar| baz)" "foo (bar| |baz)"
+ "foo (bar |baz)" "foo (bar |baz|)"
+ "foo b|ar| baz" "foo |bar| baz"
+ "foo2 (bar baz|)" "foo2 |(bar baz)|"
+ "foo3 (bar |baz|)" "foo3 |(bar baz)|"
+ "foo \"bar |baz\"" "foo |\"bar baz\"|"
+ "foo;ba|r\nbaz" "foo|;bar|\nbaz"
+ "foo (bar [ba|z] |foo)" "foo (bar |[baz] |foo)"
+ "foo (bar [ba|z]) (foo [bar (b|az)])" "foo |(bar [baz]) (foo [bar (baz)])|"
+ "foo |(bar [baz (b|am)])" "foo |(bar [baz (bam)])|"
+ ;with :chimera
+ "(foo |bar]" "(foo |bar|]"
+ "(foo |{bar)]" "(foo |{bar)|]"
+ }]
+ ["Shift+Alt+Up" :paredit-expand-up
+ {
+ "abc defgh|i " "abc |defghi| "
+ "|abc| defghi " "|abc defghi |"
+ "foo bar| baz" "|foo bar baz|"
+ "foo bar |baz" "|foo bar baz|"
+ "foo ba|r baz" "foo |bar| baz"
+ "foo7 bar b|a|z" "foo7 bar |baz|"
+ "foo8 bar ba|z|" "foo8 bar |baz|"
+ "foo9 bar |baz|" "|foo9 bar baz|"
+ "foo bar| baz|" "|foo bar baz|"
+ "foo |bar baz|" "|foo bar baz|"
+ "|foo bar baz" "|foo bar baz|"
+ "|f|oo bar baz" "|foo| bar baz"
+ "|foo| bar baz" "|foo bar baz|"
+ "|foo |bar baz" "|foo bar baz|"
+ "|foo b|ar baz" "|foo bar| baz"
+ "foo4 (bar| baz)" "foo4 |(bar baz)|"
+ "foo5 (bar |baz)" "foo5 |(bar baz)|"
+ "foo b|ar| baz" "foo |bar| baz"
+ "foo6 (bar baz|)" "foo6 |(bar baz)|"
+ "foo7 (bar |baz|)" "foo7 |(bar baz)|"
+ "foo \"bar |baz\"" "foo |\"bar baz\"|"
+ "foo;ba|r\nbaz" "foo|;bar|\nbaz"
+ "foo (bar [ba|z] |foo)" "foo (bar |[baz] |foo)"
+ "foo (bar [ba|z]) (foo [bar (b|az)])" "foo |(bar [baz]) (foo [bar (baz)])|"
+ "foo |(bar [baz (b|am)])" "foo |(bar [baz (bam)])|"
+ "foo ([|bar])" "foo (|[bar]|)"
+ "foo ([b|ar])" "foo ([|bar|])"
+ "foo ([b|a|r])" "foo ([|bar|])"
+ "foo ([|bar|])" "foo (|[bar]|)"
+ "foo (|[bar]|)" "foo |([bar])|"
+ ;with :chimera
+ "(foo |bar]" "|(foo bar]|"
+ "(foo |{bar)]" "|(foo {bar)]|"
+ }]
+ ]
+ ["Miscellaneous"
+ ["Tab" :paredit-indent-line
+ {"[a\n|b]" "[a\n |b]"
+ "([a1\n|b])" "([a1\n |b])"
+ "([a1b\n |b])" "([a1b\n |b])"
+ "(a\n |)" "(a\n |)"
+ "(a b c\nd| e)" "(a b c\n d| e)"
+ "|(toto)" "|(toto)"
+ "(a\n ;sdfdf\n |b)" "(a\n ;sdfdf\n |b)"
+ "[a\n \"b\n |\"]" "[a\n \"b\n |\"]"
+ "[a\n|\"a\"]" "[a\n |\"a\"]"
+ "(a\n\t|b)" "(a\n |b)"
+ "(\n|\n)" "(\n |\n)"
+ "(\n |\n)" "(\n |\n)"
+ "(\n |\n)" "(\n |\n)"
+ "(\n |\n)" "(\n |\n)"
+ "(\n , |\n)" "(\n |\n)"
+ " {\n|a}" " {\n |a}"
+ " (\n| ab c)" " (\n| ab c)"
+ " (\n | ab c)" " (\n | ab c)"
+ " (\n | ab c)" " (\n | ab c)"
+ " (\n | ab c)" " (\n |ab c)"
+ " (\n |ab c)" " (\n |ab c)"
+ " (\n a|b c)" " (\n a|b c)"
+ " (\n | ab c)" " (\n| ab c)"
+ " (\n | ab c)" " (\n | ab c)"
+ " (\n |ab c)" " (\n |ab c)"
+ " (\n| ab c)" " (\n| ab c)"
+ " (\n | ab c)" " (\n | ab c)"
+ "(a\n |b" "(a\n |b"
+ ;;;"foo (let [n (frobbotz)] \n|(display (+ n 1)\nport))\n bar"
+ ;;;(str "foo (let [n (frobbotz)]"
+ ;;; "\n |(display (+ n 1)"
+ ;;; "\n port))\n bar"
+ ;; )
+ " a\n |" " a\n |"
+ ")|s" ")|s"
+ ")\n|s" ")\n|s"
+ "#(a\n|)" "#(a\n |)"
+ ; with chimera
+ "(a\n|(])" "(a\n |(])"
+ "(a\n|" "(a\n |"
+ "(a\n|]" "(a\n |]"
+ " #(a\n|]" " #(a\n |]"
+ }]
+ [#"C-j" :paredit-newline
+ {"(ab|cd)" "(ab\n |cd)"
+ "(ab| cd)" "(ab\n |cd)"
+ " a|" " a\n |"
+ ;"foo (let [n (frobbotz)] |(display (+ n 1)\nport))\n bar"
+ ;(str "foo (let [n (frobbotz)]"
+ ; "\n |(display (+ n 1)"
+ ; "\n port))\n bar")
+ }]
+ ["M-S" :paredit-split-sexp
+ {"(hello | world)" "(hello)| (world)",
+ "\"Hello, |world!\"" "\"Hello, \"| \"world!\"",
+ "(hel|lo)" "(hel)| (lo)",
+ "[hello |world]" "[hello]| [world]",
+ "{hello brave |new world}" "{hello brave}| {new world}",
+ "{|}" "{}| {}"
+ "(foo|)" "(foo)| ()"
+ "({|})" "({}| {})"
+ "(defn hello |[world])" "(defn hello)| ([world])"
+ }]
+ ["M-J" :paredit-join-sexps
+ {"(hello)| (world)" "(hello| world)",
+ "\"Hello, \"| \"world!\"" "\"Hello, |world!\"",
+ "hello-\n| world" "hello-|world"
+ "({:foo :bar}| {:baz :fooz})" "({:foo :bar| :baz :fooz})"
+ "({:foo :bar} |{:baz :fooz})" "({:foo :bar |:baz :fooz})"
+ "({:foo :bar} {|:baz :fooz})" "({:foo :bar} {|:baz :fooz})"
+ "({:baz :fooz|} {:foo :bar})" "({:baz :fooz|} {:foo :bar})"
+ }]
+ ]
+ ])
230 src/paredit/loc_utils.clj
@@ -0,0 +1,230 @@
+(ns paredit.loc-utils
+ (:use paredit.parser)
+ (:require [clojure.zip :as zip])
+ (:require [clojure.contrib.zip-filter :as zf]))
+
+#_(set! *warn-on-reflection* true)
+
+(defn xml-vzip
+ "Returns a zipper for xml elements (as from xml/parse),
+ given a root element"
+ {:added "1.0"}
+ [root]
+ (zip/zipper (complement string?)
+ :content
+ (fn [node children]
+ (assoc node :content children))
+ root))
+
+(defn split [cs idx]
+ (when cs
+ [(subvec cs 0 idx) (cs idx) (subvec cs (inc idx))]))
+
+(defn vdown
+ "Returns the loc of the child at index idx of the node at this loc, or
+ nil if no children"
+ {:added "1.0"}
+ [loc idx]
+ (when (zip/branch? loc)
+ (let [[node path] loc
+ [l c r :as cs] (split (zip/children loc) idx)]
+ (when cs
+ (with-meta [c {:l l
+ :pnodes (if path (conj (:pnodes path) node) [node])
+ :ppath path
+ :r r}] (meta loc))))))
+
+(defn node-text [n]
+ (if (string? n)
+ n
+ (apply str (map #'node-text (:content n)))))
+
+(defn loc-text [loc]
+ (node-text (zip/node loc)))
+
+(defn loc-count [loc]
+ ;(cond
+ ; (nil? loc) 0
+ ; (string? (zip/node loc)) (.length ^String (zip/node loc))
+ ; (zip/down loc) (apply + (map #'loc-count (concat [(zip/down loc)] (zip/rights (zip/down loc)))))
+ ; :else 0))
+ (if (zip/branch? loc)
+ (or (:count (zip/node loc)) 0)
+ (count (zip/node loc))))
+
+(defn ^String loc-tag [loc]
+ (and loc
+ (:tag (zip/node (if (string? (zip/node loc)) (zip/up loc) loc)))))
+
+(defn same-parent? [loc & locs]
+ (let [loc-parent-path (butlast (zip/path loc))]
+ (every? #(= (butlast (zip/path %)) loc-parent-path) locs)))
+
+(defn loc-depth
+ "returns the depth in the tree of the given loc"
+ [loc]
+ (count (zip/path loc)))
+
+(defn up-to-depth
+ "finds from the loc the ancestor loc at the given depth."
+ [loc depth]
+ (let [delta (- (loc-depth loc) depth)]
+ (cond
+ (zero? delta) loc
+ :else (nth (iterate zip/up loc) delta))))
+
+(defn punct-loc?
+ "true if the loc corresponds to punctuation."
+ [loc]
+ (and
+ loc
+ (string? (zip/node loc))
+ (not ((conj *atom* :whitespace :comment :char :string :regex) (loc-tag (zip/up loc))))))
+
+(defn root-loc [loc] (if-let [up (zip/up loc)] (recur up) loc))
+
+(defn rlefts
+ "like clojure.zip/lefts, but in reverse order (optimized lazy sequence)"
+ [loc]
+ (rest (take-while identity (iterate zip/left loc))))
+
+(defn next-leaves
+ "seq of next leaves locs" ;; TODO correct this aberration: next-leaves includes the current leave ... (or change the name ...)
+ [loc]
+ (and loc (remove zip/branch? (take-while (complement zip/end?) (iterate zip/next loc)))))
+
+(defn previous-leaves
+ "seq of previous leaves locs"
+ [loc]
+ (and loc (remove zip/branch? (take-while (complement nil?) (iterate zip/prev (zip/prev loc))))))
+
+;; TODO we should be able to locate the offset by first looking at the loc index,
+;; and then get the :content-cumulative-count, etc.
+(defn start-offset [loc]
+ (loop [loc loc offset 0]
+ (cond
+ (nil? loc) offset
+ :else
+ (if-let [l (zip/left loc)]
+ (recur l (+ offset (loc-count l)))
+ (recur (zip/up loc) offset)))))
+
+(defn end-offset [loc]
+ (+ (start-offset loc) (loc-count loc)))
+
+(defn loc-col [loc]
+ (loop [loc (zip/prev loc) col 0]
+ (cond
+ (nil? loc)
+ col
+ (string? (zip/node loc))
+ (if (.contains ^String (zip/node loc) "\n")
+ (+ col (dec (-> ^String (zip/node loc) (.substring (.lastIndexOf ^String (zip/node loc) "\n")) .length)))
+ (recur (zip/prev loc) (+ col (loc-count loc))))
+ :else
+ (recur (zip/prev loc) col))))
+
+(defn loc-parse-node [loc] ; wrong name, and also, will return (foo) if located at ( or at ) ... so definitely wrong name ...
+ (if (string? (zip/node loc))
+ (zip/up loc)
+ loc))
+
+(defn parse-leave
+ "returns a leave which corresponds to a parse information: either a (punct-loc?) (beware: a bare String, not a node with meta-data,
+ or a parse atom"
+ [loc]
+ (cond
+ (punct-loc? loc) loc
+ (string? (zip/node loc)) (zip/up loc)
+ :else loc))
+
+(defn parse-node
+ "transforms the loc in a parse-leave, and if a punct, returns the parent loc"
+ [loc]
+ (let [loc (parse-leave loc)]
+ (if (punct-loc? loc) (zip/up loc) loc)))
+
+(defn parsed-root-loc
+ ([parsed] (parsed-root-loc parsed false))
+ ([parsed only-valid?]
+ ;(let [valid? (= 1 (-> parsed :accumulated-state count))]
+ (xml-vzip parsed)))
+
+(defn contains-offset?
+ "returns the loc itself if it contains the offset, else nil"
+ [loc offset]
+ (let [start (start-offset loc)
+ end (+ (loc-count loc) start)]
+ (and
+ (<= start offset (dec end))
+ loc)))
+
+(defn leave-loc-for-offset-common
+ "returns a zipper location or nil if does not contain the offset"
+ [loc offset]
+ (if (not (zip/branch? loc))
+ (if (< offset (count (zip/node loc))) loc (root-loc loc))
+ (let [[cloc offset]
+ (loop [start (int 0) end (int (count (-> loc zip/node :content)))]
+ (if (<= end start)
+ (if (= start (count (-> loc zip/node :content)))
+ [(root-loc loc) 0] ; problem, no loc found (end of text, will return root-loc instead)
+ [(vdown loc start) (- offset (-> loc zip/node :content-cumulative-count (get start)))])
+ (let [n (int (+ start (quot (- end start) 2)))
+ n-offset (-> loc zip/node :content-cumulative-count (get n))
+ n-node (-> loc zip/node :content (get n))
+ n-count (if (string? n-node) (count n-node) (or (:count n-node) 0))]
+ (cond
+ (< offset n-offset)
+ (recur start (dec n))
+ (< offset (+ n-offset n-count))
+ [(vdown loc n) (- offset n-offset)]
+ :else
+ (recur (inc n) end)))))]
+ (if (zero? offset) cloc (recur cloc offset)))))
+
+(defn leave-for-offset
+ [loc offset]
+ (if-let [l (leave-loc-for-offset-common loc offset)]
+ l
+ (root-loc loc)))
+
+(defn loc-for-offset
+ "returns a zipper location or nil if does not contain the offset"
+ [loc offset]
+ (when-let [l (leave-loc-for-offset-common loc offset)]
+ (parse-node l)))
+
+(defn loc-containing-offset
+ [loc offset]
+ (if-let [l (leave-loc-for-offset-common loc offset)]
+ (loop [l l]
+ (cond
+ (= (root-loc loc) l) l
+ (= offset (start-offset l)) (recur (zip/up l))
+ :else l))
+ (root-loc loc)))
+
+#_(defn loc-containing-offset
+ ([loc offset]
+ (if (= 0 offset)
+ (root-loc loc)
+ (let [match (some #(contains-offset? % offset) (take-while (complement zip/end?) (iterate zip/next (zip/next (root-loc loc)))))]
+ (cond
+ (nil? match) (root-loc loc)
+ (= offset (start-offset match)) (zip/up match)
+ :else match)))))
+
+(defn start-punct?
+ "true if the loc is a punct starting a form"
+ [loc]
+ (and
+ (punct-loc? loc)
+ (= (start-offset loc) (start-offset (parse-node loc)))))
+
+(defn end-punct?
+ "true if the loc is a punct ending a form"
+ [loc]
+ (and
+ (punct-loc? loc)
+ (= (end-offset loc) (end-offset (parse-node loc)))))
26 src/paredit/regex_utils.clj
@@ -0,0 +1,26 @@
+(ns paredit.regex-utils
+ (:import java.util.regex.Pattern)
+ (:require [clojure.contrib.str-utils2 :as str2]))
+
+(defprotocol Patternable (pattern [this] "given this, returns a String corresponding to the pattern"))
+
+(extend-protocol Patternable
+ Pattern
+ (pattern [this] (.pattern this))
+ String
+ (pattern [this] this))
+
+(defmacro interpol-regex
+ "delim: literal char (or one-char String) for delimiting where the variables are. Optional, defaults to \\`
+ regex: literal regex, or an object which implements protocol Patternable
+ Usage: (interpol-regex \"foo\") => #\"foo\"
+ (interpol-regex #\"foo\" => #\"foo\"
+ (let [x #\"baz\\(\" y \"bar\"] (interpol-regex #\"(?:a|`x`|`y`)\")
+ => #\"(?:a|baz\\(|bar)\""
+ ([regex] `(interpol-regex \` ~regex))
+ ([delim regex]
+ (let [escaped-delim (str \\ delim)
+ partitioning-pattern (Pattern/compile (str escaped-delim "([^" escaped-delim "]+)" escaped-delim))
+ exploded-pattern (str2/partition (pattern regex) partitioning-pattern)]
+ `(java.util.regex.Pattern/compile (str ~@(map #(if (string? %) % `(str "(?:" (pattern ~(symbol (get % 1))) ")")) exploded-pattern))))))
+
80 src/paredit/text_utils.clj
@@ -0,0 +1,80 @@
+(ns paredit.text-utils
+ (:use clojure.test))
+
+#_(set! *warn-on-reflection* true)
+
+(defn str-insert [^String s i c] (str (.substring s 0 i) c (.substring s i)))
+(defn str-remove [^String s i n] (str (.substring s 0 i) (.substring s (+ i n))))
+(defn str-replace [^String s offset length text] (str (.substring s 0 offset) text (.substring s (+ offset length))))
+
+(defn insert
+ "insert what at offset. offset shifted by what's length, selection length unchanged"
+ ([{:keys [^String text offset length modifs] :as where :or {:modifs []}} ^String what]
+ (let [new-offset (+ offset (.length what))]
+ (assoc where
+ :text (str (.substring text 0 offset) what (.substring text offset))
+ :offset new-offset
+ :modifs (conj modifs {:text what, :offset offset, :length 0})))))
+
+(defn delete
+ "removes n chars at offset off. offset not shifted, selection length unchanged"
+ ; TODO FIXME : decrease length if now that things are removed, length would make the selection overflow the text
+ ; and also adjust :offset if off is before it
+ [{:keys [^String text offset length modifs] :as where :or {:modifs []}} off n]
+ (assoc where
+ :text (str (.substring text 0 off) (.substring text (+ off n)))
+ :offset offset
+ :modifs (conj modifs {:text "", :offset off, :length n})))
+
+(defn shift-offset
+ "shift offset, the selection is also shifted"
+ [{:keys [text offset length] :as where} shift]
+ (assoc where :offset (+ offset shift)))
+
+(defn set-offset
+ "sets offset, the selection is also shifted"
+ [{:keys [text offset length] :as where} new-offset]
+ (assoc where :offset new-offset))
+
+; TODO faire comme next-char sur l'utilisation de length
+; !! attention pas de gestion de length negative
+(defn previous-char-str
+ ([{:keys [^String text offset length] :as t}] (previous-char-str t 1))
+ ([{:keys [^String text offset length] :as t} n]
+ (assert (>= length 0))
+ (when (< -1 (- offset n) (.length text))
+ (str (.charAt text (- offset n))))))
+
+(defn next-char-str [{:keys [^String text offset length] :as t}]
+ (assert (>= length 0))
+ (when (< -1 (+ offset length) (.length text))
+ (str (.charAt text (+ offset length)))))
+
+(defn line-start
+ "returns the offset corresponding to the start of the line of offset offset in s"
+ [^String s offset]
+ (loop [offset offset]
+ (cond
+ (<= offset 0) 0
+ (and (<= offset (.length s)) (= \newline (.charAt s (dec offset)))) offset
+ :else (recur (dec offset)))))
+
+(defn line-stop
+ "returns the offset corresponding to the end of the line of offset offset in s (excluding carridge return, newline "
+ [^String s offset]
+ (loop [offset offset]
+ (cond
+ (>= offset (.length s)) (.length s)
+ (and
+ (> offset 0)
+ (#{\return \newline} (.charAt s offset)))
+ offset
+ :else (recur (inc offset)))))
+
+(deftest line-stop-tests
+ (are [expected s o] (= expected (line-stop s o))
+ 0 "" 0
+ 1 " " 0
+ 5 " a\n" 5
+ 5 "(\n , \n)" 5
+ 5 "[a\nb]" 3))

0 comments on commit ffa3033

Please sign in to comment.