Merge branch 'ar/userdiff-scheme'

Userdiff patterns for "Scheme" has been added.

* ar/userdiff-scheme:
  userdiff: add support for Scheme

18 files changed, 101 insertions, 0 deletions

diff --git a/Documentation/gitattributes.txt b/Documentation/gitattributes.txt
index 0a60472bb5..cfcfa800c2 100644
--- a/Documentation/gitattributes.txt
+++ b/Documentation/gitattributes.txt
@@ -845,6 +845,8 @@ patterns are available:
 
 - `rust` suitable for source code in the Rust language.
 
+- `scheme` suitable for source code in the Scheme language.
+
 - `tex` suitable for source code for LaTeX documents.
 
 
diff --git a/t/t4018-diff-funcname.sh b/t/t4018-diff-funcname.sh
index 9675bc17db..823ea96acb 100755
--- a/t/t4018-diff-funcname.sh
+++ b/t/t4018-diff-funcname.sh
@@ -48,6 +48,7 @@ diffpatterns="
 	python
 	ruby
 	rust
+	scheme
 	tex
 	custom1
 	custom2
diff --git a/t/t4018/scheme-class b/t/t4018/scheme-class
new file mode 100644
index 0000000000..e5e07b43fb
--- /dev/null
+++ b/t/t4018/scheme-class
@@ -0,0 +1,7 @@
+(define book-class%
+  (class* () object% RIGHT
+    (field (pages 5))
+    (field (ChangeMe 5))
+    (define/public (letters)
+      (* pages 500))
+    (super-new)))
diff --git a/t/t4018/scheme-def b/t/t4018/scheme-def
new file mode 100644
index 0000000000..1e2673da96
--- /dev/null
+++ b/t/t4018/scheme-def
@@ -0,0 +1,4 @@
+(def (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-def-variant b/t/t4018/scheme-def-variant
new file mode 100644
index 0000000000..d857a61d64
--- /dev/null
+++ b/t/t4018/scheme-def-variant
@@ -0,0 +1,4 @@
+(defmethod {print point} RIGHT
+  (lambda (self)
+    (with ((point x y) self)
+      (printf "{ChangeMe x:~a y:~a}~n" x y))))
diff --git a/t/t4018/scheme-define-slash-public b/t/t4018/scheme-define-slash-public
new file mode 100644
index 0000000000..39a93a1600
--- /dev/null
+++ b/t/t4018/scheme-define-slash-public
@@ -0,0 +1,7 @@
+(define bar-class%
+  (class object%
+    (field (info 5))
+    (define/public (foo) RIGHT
+      (+ info 42)
+      (* info ChangeMe))
+    (super-new)))
diff --git a/t/t4018/scheme-define-syntax b/t/t4018/scheme-define-syntax
new file mode 100644
index 0000000000..7d5e99e0fc
--- /dev/null
+++ b/t/t4018/scheme-define-syntax
@@ -0,0 +1,8 @@
+(define-syntax define-test-suite RIGHT
+  (syntax-rules ()
+    ((_ suite-name (name test) ChangeMe ...)
+     (define suite-name
+       (let ((tests
+              `((name . ,test) ...)))
+         (lambda ()
+           (run-suite 'suite-name tests)))))))
diff --git a/t/t4018/scheme-define-variant b/t/t4018/scheme-define-variant
new file mode 100644
index 0000000000..911708854d
--- /dev/null
+++ b/t/t4018/scheme-define-variant
@@ -0,0 +1,4 @@
+(define* (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-library b/t/t4018/scheme-library
new file mode 100644
index 0000000000..82ea3df510
--- /dev/null
+++ b/t/t4018/scheme-library
@@ -0,0 +1,11 @@
+(library (my-helpers id-stuff) RIGHT
+  (export find-dup)
+  (import (ChangeMe))
+  (define (find-dup l)
+    (and (pair? l)
+         (let loop ((rest (cdr l)))
+           (cond
+            [(null? rest) (find-dup (cdr l))]
+            [(bound-identifier=? (car l) (car rest))
+             (car rest)]
+            [else (loop (cdr rest))])))))
diff --git a/t/t4018/scheme-local-define b/t/t4018/scheme-local-define
new file mode 100644
index 0000000000..bc6d8aebbe
--- /dev/null
+++ b/t/t4018/scheme-local-define
@@ -0,0 +1,4 @@
+(define (higher-order)
+  (define local-function RIGHT
+    (lambda (x)
+     (car "this is" "ChangeMe"))))
diff --git a/t/t4018/scheme-module b/t/t4018/scheme-module
new file mode 100644
index 0000000000..edfae0ebf7
--- /dev/null
+++ b/t/t4018/scheme-module
@@ -0,0 +1,6 @@
+(module A RIGHT
+  (export with-display-exception)
+  (extern (display-exception display-exception ChangeMe))
+  (def (with-display-exception thunk)
+    (with-catch (lambda (e) (display-exception e (current-error-port)) e)
+      thunk)))
diff --git a/t/t4018/scheme-top-level-define b/t/t4018/scheme-top-level-define
new file mode 100644
index 0000000000..624743c22b
--- /dev/null
+++ b/t/t4018/scheme-top-level-define
@@ -0,0 +1,4 @@
+(define (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-user-defined-define b/t/t4018/scheme-user-defined-define
new file mode 100644
index 0000000000..35fe7cc9bf
--- /dev/null
+++ b/t/t4018/scheme-user-defined-define
@@ -0,0 +1,6 @@
+(define-test-suite record\ case-tests RIGHT
+  (record-case-1 (lambda (fail)
+                   (let ((a (make-foo 1 2)))
+                     (record-case a
+                       ((bar x) (ChangeMe))
+                       ((foo a b) (+ a b)))))))
diff --git a/t/t4034-diff-words.sh b/t/t4034-diff-words.sh
index 56f1e62a97..ee7721ab91 100755
--- a/t/t4034-diff-words.sh
+++ b/t/t4034-diff-words.sh
@@ -325,6 +325,7 @@ test_language_driver perl
 test_language_driver php
 test_language_driver python
 test_language_driver ruby
+test_language_driver scheme
 test_language_driver tex
 
 test_expect_success 'word-diff with diff.sbe' '
diff --git a/t/t4034/scheme/expect b/t/t4034/scheme/expect
new file mode 100644
index 0000000000..496cd5de8c
--- /dev/null
+++ b/t/t4034/scheme/expect
@@ -0,0 +1,11 @@
+<BOLD>diff --git a/pre b/post<RESET>
+<BOLD>index 74b6605..63b6ac4 100644<RESET>
+<BOLD>--- a/pre<RESET>
+<BOLD>+++ b/post<RESET>
+<CYAN>@@ -1,6 +1,6 @@<RESET>
+(define (<RED>myfunc a b<RESET><GREEN>my-func first second<RESET>)
+  ; This is a <RED>really<RESET><GREEN>(moderately)<RESET> cool function.
+  (<RED>this\place<RESET><GREEN>that\place<RESET> (+ 3 4))
+  (define <RED>some-text<RESET><GREEN>|a greeting|<RESET> "hello")
+  (let ((c (<RED>+ a b<RESET><GREEN>add1 first<RESET>)))
+    (format "one more than the total is %d" (<RED>add1<RESET><GREEN>+<RESET> c <GREEN>second<RESET>))))
diff --git a/t/t4034/scheme/post b/t/t4034/scheme/post
new file mode 100644
index 0000000000..63b6ac4f87
--- /dev/null
+++ b/t/t4034/scheme/post
@@ -0,0 +1,6 @@
+(define (my-func first second)
+  ; This is a (moderately) cool function.
+  (that\place (+ 3 4))
+  (define |a greeting| "hello")
+  (let ((c (add1 first)))
+    (format "one more than the total is %d" (+ c second))))
diff --git a/t/t4034/scheme/pre b/t/t4034/scheme/pre
new file mode 100644
index 0000000000..74b6605357
--- /dev/null
+++ b/t/t4034/scheme/pre
@@ -0,0 +1,6 @@
+(define (myfunc a b)
+  ; This is a really cool function.
+  (this\place (+ 3 4))
+  (define some-text "hello")
+  (let ((c (+ a b)))
+    (format "one more than the total is %d" (add1 c))))
diff --git a/userdiff.c b/userdiff.c
index 3f81a2261c..3897317aff 100644
--- a/userdiff.c
+++ b/userdiff.c
@@ -191,6 +191,15 @@ PATTERNS("rust",
 	 "[a-zA-Z_][a-zA-Z0-9_]*"
 	 "|[0-9][0-9_a-fA-Fiosuxz]*(\\.([0-9]*[eE][+-]?)?[0-9_fF]*)?"
 	 "|[-+*\\/<>%&^|=!:]=|<<=?|>>=?|&&|\\|\\||->|=>|\\.{2}=|\\.{3}|::"),
+PATTERNS("scheme",
+	 "^[\t ]*(\\(((define|def(struct|syntax|class|method|rules|record|proto|alias)?)[-*/ \t]|(library|module|struct|class)[*+ \t]).*)$",
+	 /*
+	  * R7RS valid identifiers include any sequence enclosed
+	  * within vertical lines having no backslashes
+	  */
+	 "\\|([^\\\\]*)\\|"
+	 /* All other words should be delimited by spaces or parentheses */
+	 "|([^][)(}{[ \t])+"),
 PATTERNS("bibtex", "(@[a-zA-Z]{1,}[ \t]*\\{{0,1}[ \t]*[^ \t\"@',\\#}{~%]*).*$",
 	 "[={}\"]|[^={}\" \t]+"),
 PATTERNS("tex", "^(\\\\((sub)*section|chapter|part)\\*{0,1}\\{.*)$",