tags: don't escape etag patterns

The first field of each etag definition is referred to in the spec as
the "pattern", but it is supposed to contain literal text, and therefore
no characters within it need be escaped.

* tags.tl (escape): Move above tag definition.
(tag)[pattern]: Rename to...
[line]: ...this.
[text]: Update renamed slot. Escape the line here rather than on
creation.
[etext]: Update renamed slot.
(slot-tag)[text]: Update renamed slot. Escape the line here rather than
on creation.
(orig-tag)[line]: Rename to...
[orig-line]: ...this.
[text]: Update renamed slot.
(get-pos-pat): Rename to...
(get-pos-line): ...this. Don't escape the line when returning it.
(with-tag-shorthand-macro, toplevel): Rename variables and references to
functions in accordance with the above.

1 files changed, 20 insertions, 21 deletions

diff --git a/tags.tl b/tags.tl
index bae1840e..8bd6cebf 100755
--- a/tags.tl
+++ b/tags.tl
@@ -19,31 +19,31 @@
   (e   emacs   :bool "Write the tags file in Emacs's etags format.")
   (q   qual    :bool "Also generate struct:slot tags for each slot."))
 
+(defun escape (str)
+  (mappend (do caseql @1
+             ((#\^ #\$ #\/ #\\) (list #\\ @1))
+             (t (list @1)))
+           str))
+
 (defstruct tag ()
   ident
   path
   linum
   byte
-  pattern
+  line
   (type "?")
 
   (:postinit (me)
     (upd me.ident tostringp))
 
   (:method text (me)
-    `@{me.ident}\t@{me.path}\t/^@{me.pattern}$/;"\t@{me.type}`)
+    `@{me.ident}\t@{me.path}\t/^@(escape me.line)$/;"\t@{me.type}`)
 
   (:method etext (me)
-    `@{me.pattern}@{etag-pat-end} \
+    `@{me.line}@{etag-pat-end} \
      @{me.ident}@{etag-name-end} \
      @{me.linum},@{me.byte}`))
 
-(defun escape (str)
-  (mappend (do caseql @1
-             ((#\^ #\$ #\/ #\\) (list #\\ @1))
-             (t (list @1)))
-           str))
-
 (defstruct file-tag tag
   (type "F")
   (:postinit (me)
@@ -68,7 +68,7 @@
   parent
   expattern
   (:method text (me)
-    `@{me.ident}\t@{me.path}\t/^@{me.pattern}$/ \
+    `@{me.ident}\t@{me.path}\t/^@(escape me.line)$/ \
      @(if me.expattern `;/@(escape me.ident)/`);"\t \
      @{me.type}\tstruct:@{me.parent}`)
   (:method make-qual-tag (me)
@@ -78,14 +78,14 @@
         qt))))
 
 (defstruct orig-tag tag
-  line
-  (:method text (me) me.line))
+  orig-line
+  (:method text (me) me.orig-line))
 
 (defvarl err-ret (gensym))
 
 (defvar *fake-load-path*)
 
-(defun get-pos-pat (lines form)
+(defun get-pos-line (lines form)
   (tree-case (source-loc form)
     ((line . file)
      ;; The file-get-string function keeps carriage returns, so the byte
@@ -93,8 +93,7 @@
      (let ((byte (+ line ; Count the newlines.
                     -1   ; Adjust the byte offset to be 0-based.
                     [sum (take line lines) coded-length])))
-       (cons (cons line byte)
-             (escape [lines line]))))))
+       (cons (cons line byte) [lines line])))))
 
 (defmacro in-anon-package (. body)
   (with-gensyms (pkg)
@@ -107,16 +106,16 @@
 (defmacro with-tag-shorthand-macro ((name-sym path-var lines-var obj-var)
                                     . body)
   ^(macrolet ((,name-sym (type ident : parent pattern-obj)
-                (with-gensyms (linum byte pat)
+                (with-gensyms (linum byte line)
                   ^(tree-case ,(if pattern-obj
-                                 ^(get-pos-pat ,',lines-var ,pattern-obj)
-                                 ^(get-pos-pat ,',lines-var ,',obj-var))
-                     (((,linum . ,byte) . ,pat)
+                                 ^(get-pos-line ,',lines-var ,pattern-obj)
+                                 ^(get-pos-line ,',lines-var ,',obj-var))
+                     (((,linum . ,byte) . ,line)
                       (new ,type ident ,ident
                                  path ,',path-var
                                  linum ,linum
                                  byte ,byte
-                                 pattern ,pat
+                                 line ,line
                                  ,*(if parent ^(parent ,parent))
                                  ,*(if pattern-obj ^(expattern t))))))))
      ,*body))
@@ -264,7 +263,7 @@
       (let* ((lines (file-get-lines o.output))
              (orig-tags (collect-each ((line lines))
                           (new orig-tag ident (m^ #/[^\t]*/ line)
-                                        line line))))
+                                        orig-line line))))
         (set tags (merge tags orig-tags : .ident)))
       (path-not-found (e))))
   (with-stream (stream (open-file o.output (if o.append "a" "w")))