Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add escape of parens in href strings, to make the use of such URLs mo…

…re robust with external

tools.

External tools on the web often incorrectly delimit the
URLs used in Scribble anchors when it contains parens.  Mis-delimiting
the URL causes the link to break.  Jeff Atwood recommends escaping
parens as well that tools such as Wikipedia and Stack Overflow don't
fail so badly:  http://www.codinghorror.com/blog/2008/10/the-problem-with-urls.html
  • Loading branch information...
commit a6662bb13808ba4351c5d389cdbaa7284f3b75f2 1 parent 4ff4c67
Danny Yoo authored

Showing 1 changed file with 69 additions and 55 deletions. Show diff stats Hide diff stats

  1. 124  collects/scribble/html-render.rkt
124  collects/scribble/html-render.rkt
@@ -114,6 +114,17 @@
114 114
            [v (regexp-replace* #rx#"[^-a-zA-Z0-9_!+*'()/.,]" v encode-bytes)])
115 115
       (bytes->string/utf-8 v))))
116 116
 
  117
+
  118
+;; encode-href: string -> string
  119
+;; Escape the parens in href URLs to make them nicer for external
  120
+;; tools.
  121
+(define (encode-href s)
  122
+  (define (escape-paren v)
  123
+    (cond [(string=? v "(") "%28"]
  124
+          [(string=? v ")") "%29"]))
  125
+  (regexp-replace* "[()]" s escape-paren))
  126
+
  127
+
117 128
 (define-serializable-struct literal-anchor (string))
118 129
 
119 130
 (define (color->string c)
@@ -416,7 +427,7 @@
416 427
       (define top (car toc-chain))
417 428
       (define (toc-item->title+num t show-mine?)
418 429
         (values
419  
-         `((a ([href ,(dest->url (resolve-get t ri (car (part-tags/nonempty t))))]
  430
+         `((a ([href ,(encode-href (dest->url (resolve-get t ri (car (part-tags/nonempty t)))))]
420 431
                [class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain)))
421 432
                          "tocviewselflink"
422 433
                          "tocviewlink")]
@@ -596,15 +607,16 @@
596 607
                                       (parameterize ([current-no-links #t]
597 608
                                                      [extra-breaking? #t])
598 609
                                         `((a ([href
599  
-                                               ,(format
600  
-                                                 "#~a"
601  
-                                                 (anchor-name
602  
-                                                  (add-tag-prefixes
603  
-                                                   (tag-key (if (part? p)
604  
-                                                                (car (part-tags/nonempty p))
605  
-                                                                (target-element-tag p))
606  
-                                                            ri)
607  
-                                                   prefixes)))]
  610
+                                               ,(encode-href 
  611
+                                                 (format
  612
+                                                  "#~a"
  613
+                                                  (anchor-name
  614
+                                                   (add-tag-prefixes
  615
+                                                    (tag-key (if (part? p)
  616
+                                                                 (car (part-tags/nonempty p))
  617
+                                                                 (target-element-tag p))
  618
+                                                             ri)
  619
+                                                    prefixes))))]
608 620
                                               [class
609 621
                                                   ,(cond
610 622
                                                     [(part? p) "tocsubseclink"]
@@ -1110,47 +1122,48 @@
1110 1122
                          (resolve-get/ext? part ri (link-element-tag e))])
1111 1123
              (if dest
1112 1124
                `((a [(href
1113  
-                      ,(cond
1114  
-                        [(and ext? external-root-url
1115  
-                              (let ([rel (find-relative-path
1116  
-                                          (find-doc-dir)
1117  
-                                          (relative->path (dest-path dest)))])
1118  
-                                (and (relative-path? rel)
1119  
-                                     rel)))
1120  
-                         => (lambda (rel)
1121  
-                              (url->string
1122  
-                               (struct-copy
1123  
-                                url
1124  
-                                (combine-url/relative
1125  
-                                 (string->url external-root-url)
1126  
-                                 (string-join (map (lambda (s)
1127  
-                                                     (case s
1128  
-                                                       [(up) ".."]
1129  
-                                                       [(same) "."]
1130  
-                                                       [else (path-element->string s)]))
1131  
-                                                   (explode-path rel))
1132  
-                                              "/"))
1133  
-                                [fragment
1134  
-                                 (and (not (dest-page? dest))
1135  
-                                      (anchor-name (dest-anchor dest)))])))]
1136  
-                        [(and ext? external-tag-path)
1137  
-                         ;; Redirected to search:
1138  
-                         (url->string
1139  
-                          (let ([u (string->url external-tag-path)])
1140  
-                            (struct-copy
1141  
-                             url
1142  
-                             u
1143  
-                             [query
1144  
-                              (cons (cons 'tag
1145  
-                                          (bytes->string/utf-8
1146  
-                                           (base64-encode
1147  
-                                            (string->bytes/utf-8
1148  
-                                             (format "~s" (serialize
1149  
-                                                           (link-element-tag e)))))))
1150  
-                                    (url-query u))])))]
1151  
-                        [else
1152  
-                         ;; Normal link:
1153  
-                         (dest->url dest)]))
  1125
+                      ,(encode-href
  1126
+                        (cond
  1127
+                         [(and ext? external-root-url
  1128
+                               (let ([rel (find-relative-path
  1129
+                                           (find-doc-dir)
  1130
+                                           (relative->path (dest-path dest)))])
  1131
+                                 (and (relative-path? rel)
  1132
+                                      rel)))
  1133
+                          => (lambda (rel)
  1134
+                               (url->string
  1135
+                                (struct-copy
  1136
+                                 url
  1137
+                                 (combine-url/relative
  1138
+                                  (string->url external-root-url)
  1139
+                                  (string-join (map (lambda (s)
  1140
+                                                      (case s
  1141
+                                                        [(up) ".."]
  1142
+                                                        [(same) "."]
  1143
+                                                        [else (path-element->string s)]))
  1144
+                                                    (explode-path rel))
  1145
+                                               "/"))
  1146
+                                 [fragment
  1147
+                                  (and (not (dest-page? dest))
  1148
+                                       (anchor-name (dest-anchor dest)))])))]
  1149
+                         [(and ext? external-tag-path)
  1150
+                          ;; Redirected to search:
  1151
+                          (url->string
  1152
+                           (let ([u (string->url external-tag-path)])
  1153
+                             (struct-copy
  1154
+                              url
  1155
+                              u
  1156
+                              [query
  1157
+                               (cons (cons 'tag
  1158
+                                           (bytes->string/utf-8
  1159
+                                            (base64-encode
  1160
+                                             (string->bytes/utf-8
  1161
+                                              (format "~s" (serialize
  1162
+                                                            (link-element-tag e)))))))
  1163
+                                     (url-query u))])))]
  1164
+                         [else
  1165
+                          ;; Normal link:
  1166
+                          (dest->url dest)])))
1154 1167
                      ,@(attribs)
1155 1168
                      [data-pltdoc "x"]]
1156 1169
                     ,@(if (empty-content? (element-content e))
@@ -1193,10 +1206,11 @@
1193 1206
                                   [(target-url? v)
1194 1207
                                    (if (current-no-links)
1195 1208
                                        null
1196  
-                                       `([href ,(let ([addr (target-url-addr v)])
1197  
-                                                  (if (path? addr)
1198  
-                                                      (from-root addr (get-dest-directory))
1199  
-                                                      addr))]))]
  1209
+                                       `([href ,(encode-href
  1210
+                                                 (let ([addr (target-url-addr v)])
  1211
+                                                   (if (path? addr)
  1212
+                                                       (from-root addr (get-dest-directory))
  1213
+                                                       addr)))]))]
1200 1214
                                   [else null]))
1201 1215
                                properties))
1202 1216
                (attribs))]

0 notes on commit a6662bb

Please sign in to comment.
Something went wrong with that request. Please try again.