X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=guile18%2Flang%2Felisp%2Fprimitives%2Fmatch.scm;fp=guile18%2Flang%2Felisp%2Fprimitives%2Fmatch.scm;h=0a04ef5c5ab49155a59d25854944eb40aeb5cf48;hb=139c38d9204dd07f6b235f83bae644faedbc63fd;hp=0000000000000000000000000000000000000000;hpb=652ed35a2013489d0a14fede6307cd2595abb2c4;p=lilypond.git

diff --git a/guile18/lang/elisp/primitives/match.scm b/guile18/lang/elisp/primitives/match.scm
new file mode 100644
index 0000000000..0a04ef5c5a
--- /dev/null
+++ b/guile18/lang/elisp/primitives/match.scm
@@ -0,0 +1,68 @@
+(define-module (lang elisp primitives match)
+  #:use-module (lang elisp internals fset)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 optargs))
+
+(define last-match #f)
+
+(fset 'string-match
+      (lambda (regexp string . start)
+
+	(define emacs-string-match
+
+	  (if (defined? 'make-emacs-regexp)
+
+	      ;; This is what we would do if we had an
+	      ;; Emacs-compatible regexp primitive, here called
+	      ;; `make-emacs-regexp'.
+	      (lambda (pattern str . args)
+		(let ((rx (make-emacs-regexp pattern))
+		      (start (if (pair? args) (car args) 0)))
+		  (regexp-exec rx str start)))
+
+	      ;; But we don't have Emacs-compatible regexps, and I
+	      ;; don't think it's worthwhile at this stage to write
+	      ;; generic regexp conversion code.  So work around the
+	      ;; discrepancies between Guile/libc and Emacs regexps by
+	      ;; substituting the regexps that actually occur in the
+	      ;; elisp code that we want to read.
+	      (lambda (pattern str . args)
+		(let loop ((discrepancies '(("^[0-9]+\\.\\([0-9]+\\)" .
+					     "^[0-9]+\\.([0-9]+)"))))
+		  (or (null? discrepancies)
+		      (if (string=? pattern (caar discrepancies))
+			  (set! pattern (cdar discrepancies))
+			  (loop (cdr discrepancies)))))
+		(apply string-match pattern str args))))
+
+	(let ((match (apply emacs-string-match regexp string start)))
+	  (set! last-match
+		(if match
+		    (apply append!
+			   (map (lambda (n)
+				  (list (match:start match n)
+					(match:end match n)))
+				(iota (match:count match))))
+		    #f)))
+
+	(if last-match (car last-match) %nil)))
+
+(fset 'match-beginning
+      (lambda (subexp)
+	(list-ref last-match (* 2 subexp))))
+
+(fset 'match-end
+      (lambda (subexp)
+	(list-ref last-match (+ (* 2 subexp) 1))))
+
+(fset 'substring substring)
+
+(fset 'match-data
+      (lambda* (#:optional integers reuse)
+	last-match))
+
+(fset 'set-match-data
+      (lambda (list)
+	(set! last-match list)))
+
+(fset 'store-match-data 'set-match-data)