From ef7494ed835a3a0a66cac9021570e3cd6b9bf974 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 15 Oct 2015 15:38:03 -0700
Subject: [PATCH] correct `unescape-ext` to only operate on filename (closes
 #100)

---
 file.rkt | 50 +++++++++++++++++++++++++++++++++-----------------
 1 file changed, 33 insertions(+), 17 deletions(-)

diff --git a/file.rkt b/file.rkt
index 19a2dd1..bbdf78c 100644
--- a/file.rkt
+++ b/file.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (require (for-syntax racket/base racket/syntax))
-(require racket/contract racket/path racket/match)
+(require racket/contract racket/path)
 (require (only-in racket/path filename-extension))
 (require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
 
@@ -16,13 +16,13 @@
   ;; use exists-proc to permit less strict matching.
   ;; for instance, maybe it's ok to find the source for the path.
   ((coerce/path? coerce/path?)((path? . -> . any/c)) . ->* . (or/c #f path?))
-    (parameterize ([current-directory (dirname (->complete-path starting-path))])
-      (let loop ([dir (current-directory)][path filename-to-find])
-        (and dir ; dir is #f when it hits the top of the filesystem
-             (let ([completed-path (path->complete-path path)]) 
-               (if (exists-proc completed-path)
-                   (simplify-path completed-path)
-                   (loop (dirname dir) (build-path 'up path))))))))
+  (parameterize ([current-directory (dirname (->complete-path starting-path))])
+    (let loop ([dir (current-directory)][path filename-to-find])
+      (and dir ; dir is #f when it hits the top of the filesystem
+           (let ([completed-path (path->complete-path path)]) 
+             (if (exists-proc completed-path)
+                 (simplify-path completed-path)
+                 (loop (dirname dir) (build-path 'up path))))))))
 
 
 ;; for files like svg that are not source in pollen terms,
@@ -81,24 +81,40 @@
  (check-equal? (escape-last-ext "foo.html") (->path "foo_html"))
  (check-equal? (escape-last-ext "foo.html" #\$) (->path "foo$html")))
 
-
+(define second cadr)
+(define third caddr)
+(define (last x) (car (reverse x)))
 (define+provide/contract (unescape-ext x [escape-char (world:current-extension-escape-char)])
-  ((pathish?) (char?) . ->* . coerce/path?)
+  ((coerce/string?) (char?) . ->* . coerce/path?)
   ;; if x has an escaped extension, unescape it.
-  (define xstr (->string x))
-  (define pat (regexp (format "(.*)[~a](.*)$" escape-char)))
-  (define results (regexp-match pat xstr))
-  (if results
-      (match-let ([(list _ filename ext) results])
-        (add-ext filename ext))
-      x))
+  (define-values (base name dir?) (split-path x))
+  (cond
+    [dir? x]
+    [else
+     (define x-parts (explode-path x))
+     (define filename (last x-parts))
+     (define escaped-extension-pat (pregexp (format "(.*)[~a](\\S+)$" escape-char)))
+     (define results (regexp-match escaped-extension-pat (->string filename)))
+     (if results
+         (let* ([filename-without-ext (second results)]
+                [ext (third results)]
+                [new-filename (add-ext filename-without-ext ext)])
+           (if (eq? base 'relative)
+               new-filename
+               (build-path base new-filename)))
+         x)]))
 
 
 (module-test-external
  (require sugar/coerce)
  (check-equal? (unescape-ext "foo") (->path "foo"))
+ (check-equal? (unescape-ext "foo_") (->path "foo_"))
+ (check-equal? (unescape-ext "foo_#$%") (->path "foo.#$%"))
  (check-equal? (unescape-ext "foo.html") (->path "foo.html"))
  (check-equal? (unescape-ext "foo_html") (->path "foo.html"))
+ (check-equal? (unescape-ext "foo_dir/bar") (->path "foo_dir/bar"))
+ (check-equal? (unescape-ext "foo_dir/bar.html") (->path "foo_dir/bar.html"))
+ (check-equal? (unescape-ext "foo_dir/bar_html") (->path "foo_dir/bar.html"))
  (check-equal? (unescape-ext "foo$html" #\$) (->path "foo.html"))
  (check-equal? (unescape-ext "foo_bar__html") (->path "foo_bar_.html"))
  (check-equal? (unescape-ext "foo$bar$$html" #\$) (->path "foo$bar$.html")))