New tags-fix.sh for every plugin.
authorMatt Birkholz <matt@birchwood-abbey.net>
Thu, 25 Jul 2019 20:48:51 +0000 (15:48 -0500)
committerMatt Birkholz <matt@birchwood-abbey.net>
Thu, 25 Jul 2019 20:48:51 +0000 (15:48 -0500)
15 files changed:
src/blowfish/tags-fix.sh
src/cairo/Makefile.am
src/cairo/tags-fix.sh
src/gdbm/tags-fix.sh
src/gl/Makefile.am
src/gl/tags-fix.sh
src/glib/Makefile.am
src/glib/tags-fix.sh
src/gtk/Makefile.am
src/gtk/tags-fix.sh
src/mcrypt/tags-fix.sh
src/pango/Makefile.am
src/pango/tags-fix.sh
src/pgsql/tags-fix.sh
src/x11/tags-fix.sh

index e83316cd6a0bab8dc0131ca3b9cf7b0f3e9103ff..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -4,8 +4,6 @@
 # Changes to TAGS:
 #   + Punt any generated *-shim.c and *-const.c files.
 #   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
-# Someday:
-#   + Index the .cdecls?
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
@@ -87,5 +85,5 @@ ${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
     (load-option 'ffi))
   ((access rewrite-file (->environment '(ffi build)))
    (merge-pathnames "TAGS")
-   rewriter)))
+   rewriter))
 EOF
index 9c010b13abe31eed3716ae7de5117d22f1022928..023d843ea6989f565ba17f90866784b581401d88 100644 (file)
@@ -90,7 +90,7 @@ TESTS = cairo-check.sh
 
 tags: tags-am $(sources) $(cdecls)
        $(ETAGS) -a $(sources) -r '/^([^iI].*/' $(cdecls)
-       ./tags-fix.sh cairo
+       ./tags-fix.sh
 
 EXTRA_DIST += $(sources) $(cdecls) compile.sh cairo.pkg
 EXTRA_DIST += cairo-check.sh
index aee615c4867a0bdcfa00e248dd1a973f79a73668..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -1,42 +1,89 @@
 #!/bin/sh
 # -*-Scheme-*-
 #
-# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+# Changes to TAGS:
+#   + Punt any generated *-shim.c and *-const.c files.
+#   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
-${MIT_SCHEME_EXE} --batch-mode -- "${@}" <<\EOF
-(let ((name (car (command-line-arguments))))
-  (let ((shim.c-prefix (string-append name "-shim.c,"))
-       (const.c-prefix (string-append name "-const.c,")))
-
-    (define (rewriter in out)
-      (let loop ((skipping? #f))
-       (let ((line (read-line in)))
-         (cond ((eof-object? line)
-                unspecific)
-               ((string=? line "\f")
-                (let ((next (read-line in)))
-                  (cond ((eof-object? next) (error "Bogus TAGS format:" next))
-                        ((or (string-prefix? shim.c-prefix next)
-                             (string-prefix? const.c-prefix next))
-                         (loop #t))
-                        (else
-                         (write-string line out)
-                         (newline out)
-                         (write-string next out)
-                         (newline out)
-                         (loop #f)))))
-               (skipping?
-                (loop skipping?))
-               (else
-                (write-string line out)
-                (newline out)
-                (loop skipping?))))))
-
-    (parameterize ((param:suppress-loading-message? #t))
-      (load-option 'FFI))
-    ((access rewrite-file (->environment '(ffi build)))
-     (merge-pathnames "TAGS")
-     rewriter)))
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ()
+
+  (define-integrable (make-section filename bytecount lines)
+    (cons (cons filename bytecount) lines))
+  (define-integrable section.filename caar)
+  (define-integrable section.bytecount cdar)
+  (define-integrable section.lines cdr)
+
+  (define headline-pattern
+    (compile-regsexp '(seq (line-start)
+                          (group filename (+ (char-not-in #\,)))
+                          #\,
+                          (group bytecount (+ (char-in numeric)))
+                          (line-end))))
+
+  (define (write-section section out)
+    (write-string "\f\n" out)
+    (write-string (string (section.filename section)
+                         #\, (section.bytecount section)
+                         "\n")
+                 out)
+    (for-each (lambda (line) (write-string line out) (newline out))
+             (section.lines section)))
+
+  (define (write-sections sections out)
+    (for-each (lambda (section) (write-section section out))
+             (sort sections
+                   (lambda (a b)
+                     (string<? (section.filename a)
+                               (section.filename b))))))
+
+  (define (read-section in)
+    (let loop ((lines '()))
+      (let ((line (read-line in)))
+       (if (or (eof-object? line)
+               (string=? line "\f"))
+           (reverse! lines)
+           (loop (cons line lines))))))
+
+  (define (rewriter in out)
+    (let ((line (read-line in)))
+      (cond ((eof-object? line)
+            (error "TAGS file is empty"))
+           ((not (string=? line "\f"))
+            (error "TAGS file does not start with a formfeed:" line))))
+    (let loop ((scms '()) (chs '()) (cdecls '()) (rest '()))
+      (let ((line (read-line in)))
+       (if (eof-object? line)
+           (begin
+             (write-sections scms out)
+             (write-sections chs out)
+             (write-sections rest out)
+             (write-sections cdecls out))
+           (let ((match (regsexp-match-string headline-pattern line)))
+             (if (not match)
+                 (error "TAGS file contains a bogus headline:" line))
+             (let ((filename (cdr (assq 'filename (cddr match))))
+                   (section (make-section (cdr (assq 'filename (cddr match)))
+                                          (cdr (assq 'bytecount (cddr match)))
+                                          (read-section in))))
+               (cond ((or (string-suffix? "-shim.c" filename)
+                          (string-suffix? "-const.c" filename))
+                      (loop scms chs cdecls rest))
+                     ((string-suffix? ".scm" filename)
+                      (loop (cons section scms) chs cdecls rest))
+                     ((or (string-suffix? ".c" filename)
+                          (string-suffix? ".h" filename))
+                      (loop scms (cons section chs) cdecls rest))
+                     ((string-suffix? ".cdecl" filename)
+                      (loop scms chs (cons section cdecls) rest))
+                     (else
+                      (loop scms chs cdecls (cons section rest))))))))))
+
+  (parameterize ((param:suppress-loading-message? #t))
+    (load-option 'ffi))
+  ((access rewrite-file (->environment '(ffi build)))
+   (merge-pathnames "TAGS")
+   rewriter))
 EOF
index e83316cd6a0bab8dc0131ca3b9cf7b0f3e9103ff..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -4,8 +4,6 @@
 # Changes to TAGS:
 #   + Punt any generated *-shim.c and *-const.c files.
 #   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
-# Someday:
-#   + Index the .cdecls?
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
@@ -87,5 +85,5 @@ ${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
     (load-option 'ffi))
   ((access rewrite-file (->environment '(ffi build)))
    (merge-pathnames "TAGS")
-   rewriter)))
+   rewriter))
 EOF
index 71e2c3f1926b7a0b86dbc6966ccb5ed14c22e22a..5fd9e48a7a4de63202781891efd4d76ac0d589b7 100644 (file)
@@ -95,7 +95,7 @@ TESTS = gl-check.sh
 
 tags: tags-am $(sources) $(cdecls)
        $(ETAGS) -a $(sources) -r '/^([^iI].*/' $(cdecls)
-       ./tags-fix.sh gl
+       ./tags-fix.sh
 
 EXTRA_DIST += $(sources) $(cdecls) compile.sh gl.pkg
 EXTRA_DIST += gl-tests.scm gl-check.sh
index 2a8ec6437fedc1defb743faba774b9a143f1d27f..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -1,42 +1,89 @@
 #!/bin/sh
 # -*-Scheme-*-
 #
-# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+# Changes to TAGS:
+#   + Punt any generated *-shim.c and *-const.c files.
+#   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
-${MIT_SCHEME_EXE} --batch-mode -- "${@}" <<\EOF
-(let ((name (car (command-line-arguments))))
-  (let ((shim.c-prefix (string-append name "-shim.c,"))
-       (const.c-prefix (string-append name "-const.c,")))
-
-    (define (rewriter in out)
-      (let loop ((skipping? #f))
-       (let ((line (read-line in)))
-         (cond ((eof-object? line)
-                unspecific)
-               ((string=? line "\f")
-                (let ((next (read-line in)))
-                  (cond ((eof-object? next) (error "Bogus TAGS format:" next))
-                        ((or (string-prefix? shim.c-prefix next)
-                             (string-prefix? const.c-prefix next))
-                         (loop #t))
-                        (else
-                         (write-string line out)
-                         (newline out)
-                         (write-string next out)
-                         (newline out)
-                         (loop #f)))))
-               (skipping?
-                (loop skipping?))
-               (else
-                (write-string line out)
-                (newline out)
-                (loop skipping?))))))
-
-    (parameterize ((param:suppress-loading-message? #t))
-      (load-option 'ffi))
-    ((access rewrite-file (->environment '(ffi build)))
-     (merge-pathnames "TAGS")
-     rewriter)))
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ()
+
+  (define-integrable (make-section filename bytecount lines)
+    (cons (cons filename bytecount) lines))
+  (define-integrable section.filename caar)
+  (define-integrable section.bytecount cdar)
+  (define-integrable section.lines cdr)
+
+  (define headline-pattern
+    (compile-regsexp '(seq (line-start)
+                          (group filename (+ (char-not-in #\,)))
+                          #\,
+                          (group bytecount (+ (char-in numeric)))
+                          (line-end))))
+
+  (define (write-section section out)
+    (write-string "\f\n" out)
+    (write-string (string (section.filename section)
+                         #\, (section.bytecount section)
+                         "\n")
+                 out)
+    (for-each (lambda (line) (write-string line out) (newline out))
+             (section.lines section)))
+
+  (define (write-sections sections out)
+    (for-each (lambda (section) (write-section section out))
+             (sort sections
+                   (lambda (a b)
+                     (string<? (section.filename a)
+                               (section.filename b))))))
+
+  (define (read-section in)
+    (let loop ((lines '()))
+      (let ((line (read-line in)))
+       (if (or (eof-object? line)
+               (string=? line "\f"))
+           (reverse! lines)
+           (loop (cons line lines))))))
+
+  (define (rewriter in out)
+    (let ((line (read-line in)))
+      (cond ((eof-object? line)
+            (error "TAGS file is empty"))
+           ((not (string=? line "\f"))
+            (error "TAGS file does not start with a formfeed:" line))))
+    (let loop ((scms '()) (chs '()) (cdecls '()) (rest '()))
+      (let ((line (read-line in)))
+       (if (eof-object? line)
+           (begin
+             (write-sections scms out)
+             (write-sections chs out)
+             (write-sections rest out)
+             (write-sections cdecls out))
+           (let ((match (regsexp-match-string headline-pattern line)))
+             (if (not match)
+                 (error "TAGS file contains a bogus headline:" line))
+             (let ((filename (cdr (assq 'filename (cddr match))))
+                   (section (make-section (cdr (assq 'filename (cddr match)))
+                                          (cdr (assq 'bytecount (cddr match)))
+                                          (read-section in))))
+               (cond ((or (string-suffix? "-shim.c" filename)
+                          (string-suffix? "-const.c" filename))
+                      (loop scms chs cdecls rest))
+                     ((string-suffix? ".scm" filename)
+                      (loop (cons section scms) chs cdecls rest))
+                     ((or (string-suffix? ".c" filename)
+                          (string-suffix? ".h" filename))
+                      (loop scms (cons section chs) cdecls rest))
+                     ((string-suffix? ".cdecl" filename)
+                      (loop scms chs (cons section cdecls) rest))
+                     (else
+                      (loop scms chs cdecls (cons section rest))))))))))
+
+  (parameterize ((param:suppress-loading-message? #t))
+    (load-option 'ffi))
+  ((access rewrite-file (->environment '(ffi build)))
+   (merge-pathnames "TAGS")
+   rewriter))
 EOF
index 1a0fbd252a9d59b7022b9b62a6c1e320a26c2797..1b2f8be2944328fbaba5630362b4cfde82d74e3c 100644 (file)
@@ -101,7 +101,7 @@ CLEANFILES += test-copy-1.txt
 
 tags: tags-am $(sources) $(cdecls)
        $(ETAGS) -a $(sources) -r '/^([^iI].*/' $(cdecls)
-       ./tags-fix.sh glib
+       ./tags-fix.sh
 
 EXTRA_DIST += $(sources) $(cdecls) compile.sh glib.pkg
 EXTRA_DIST += glib-tests.scm glib-check-copy.sh glib-check-list.sh
index aee615c4867a0bdcfa00e248dd1a973f79a73668..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -1,42 +1,89 @@
 #!/bin/sh
 # -*-Scheme-*-
 #
-# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+# Changes to TAGS:
+#   + Punt any generated *-shim.c and *-const.c files.
+#   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
-${MIT_SCHEME_EXE} --batch-mode -- "${@}" <<\EOF
-(let ((name (car (command-line-arguments))))
-  (let ((shim.c-prefix (string-append name "-shim.c,"))
-       (const.c-prefix (string-append name "-const.c,")))
-
-    (define (rewriter in out)
-      (let loop ((skipping? #f))
-       (let ((line (read-line in)))
-         (cond ((eof-object? line)
-                unspecific)
-               ((string=? line "\f")
-                (let ((next (read-line in)))
-                  (cond ((eof-object? next) (error "Bogus TAGS format:" next))
-                        ((or (string-prefix? shim.c-prefix next)
-                             (string-prefix? const.c-prefix next))
-                         (loop #t))
-                        (else
-                         (write-string line out)
-                         (newline out)
-                         (write-string next out)
-                         (newline out)
-                         (loop #f)))))
-               (skipping?
-                (loop skipping?))
-               (else
-                (write-string line out)
-                (newline out)
-                (loop skipping?))))))
-
-    (parameterize ((param:suppress-loading-message? #t))
-      (load-option 'FFI))
-    ((access rewrite-file (->environment '(ffi build)))
-     (merge-pathnames "TAGS")
-     rewriter)))
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ()
+
+  (define-integrable (make-section filename bytecount lines)
+    (cons (cons filename bytecount) lines))
+  (define-integrable section.filename caar)
+  (define-integrable section.bytecount cdar)
+  (define-integrable section.lines cdr)
+
+  (define headline-pattern
+    (compile-regsexp '(seq (line-start)
+                          (group filename (+ (char-not-in #\,)))
+                          #\,
+                          (group bytecount (+ (char-in numeric)))
+                          (line-end))))
+
+  (define (write-section section out)
+    (write-string "\f\n" out)
+    (write-string (string (section.filename section)
+                         #\, (section.bytecount section)
+                         "\n")
+                 out)
+    (for-each (lambda (line) (write-string line out) (newline out))
+             (section.lines section)))
+
+  (define (write-sections sections out)
+    (for-each (lambda (section) (write-section section out))
+             (sort sections
+                   (lambda (a b)
+                     (string<? (section.filename a)
+                               (section.filename b))))))
+
+  (define (read-section in)
+    (let loop ((lines '()))
+      (let ((line (read-line in)))
+       (if (or (eof-object? line)
+               (string=? line "\f"))
+           (reverse! lines)
+           (loop (cons line lines))))))
+
+  (define (rewriter in out)
+    (let ((line (read-line in)))
+      (cond ((eof-object? line)
+            (error "TAGS file is empty"))
+           ((not (string=? line "\f"))
+            (error "TAGS file does not start with a formfeed:" line))))
+    (let loop ((scms '()) (chs '()) (cdecls '()) (rest '()))
+      (let ((line (read-line in)))
+       (if (eof-object? line)
+           (begin
+             (write-sections scms out)
+             (write-sections chs out)
+             (write-sections rest out)
+             (write-sections cdecls out))
+           (let ((match (regsexp-match-string headline-pattern line)))
+             (if (not match)
+                 (error "TAGS file contains a bogus headline:" line))
+             (let ((filename (cdr (assq 'filename (cddr match))))
+                   (section (make-section (cdr (assq 'filename (cddr match)))
+                                          (cdr (assq 'bytecount (cddr match)))
+                                          (read-section in))))
+               (cond ((or (string-suffix? "-shim.c" filename)
+                          (string-suffix? "-const.c" filename))
+                      (loop scms chs cdecls rest))
+                     ((string-suffix? ".scm" filename)
+                      (loop (cons section scms) chs cdecls rest))
+                     ((or (string-suffix? ".c" filename)
+                          (string-suffix? ".h" filename))
+                      (loop scms (cons section chs) cdecls rest))
+                     ((string-suffix? ".cdecl" filename)
+                      (loop scms chs (cons section cdecls) rest))
+                     (else
+                      (loop scms chs cdecls (cons section rest))))))))))
+
+  (parameterize ((param:suppress-loading-message? #t))
+    (load-option 'ffi))
+  ((access rewrite-file (->environment '(ffi build)))
+   (merge-pathnames "TAGS")
+   rewriter))
 EOF
index 322fcc15138efa21d7f047e8e217b01fba3983a1..bb4effecf76cd0a6a60a23da7fa84b3aefb38402 100644 (file)
@@ -129,7 +129,7 @@ TESTS = gtk-check.sh
 
 tags: tags-am $(sources) $(cdecls)
        $(ETAGS) -a $(sources) -r '/^([^iI].*/' $(cdecls)
-       ./tags-fix.sh gtk
+       ./tags-fix.sh
 
 EXTRA_DIST += $(sources) $(cdecls) compile.sh gtk.pkg
 EXTRA_DIST += gtk-tests.scm gtk-check.sh
index 2a8ec6437fedc1defb743faba774b9a143f1d27f..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -1,42 +1,89 @@
 #!/bin/sh
 # -*-Scheme-*-
 #
-# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+# Changes to TAGS:
+#   + Punt any generated *-shim.c and *-const.c files.
+#   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
-${MIT_SCHEME_EXE} --batch-mode -- "${@}" <<\EOF
-(let ((name (car (command-line-arguments))))
-  (let ((shim.c-prefix (string-append name "-shim.c,"))
-       (const.c-prefix (string-append name "-const.c,")))
-
-    (define (rewriter in out)
-      (let loop ((skipping? #f))
-       (let ((line (read-line in)))
-         (cond ((eof-object? line)
-                unspecific)
-               ((string=? line "\f")
-                (let ((next (read-line in)))
-                  (cond ((eof-object? next) (error "Bogus TAGS format:" next))
-                        ((or (string-prefix? shim.c-prefix next)
-                             (string-prefix? const.c-prefix next))
-                         (loop #t))
-                        (else
-                         (write-string line out)
-                         (newline out)
-                         (write-string next out)
-                         (newline out)
-                         (loop #f)))))
-               (skipping?
-                (loop skipping?))
-               (else
-                (write-string line out)
-                (newline out)
-                (loop skipping?))))))
-
-    (parameterize ((param:suppress-loading-message? #t))
-      (load-option 'ffi))
-    ((access rewrite-file (->environment '(ffi build)))
-     (merge-pathnames "TAGS")
-     rewriter)))
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ()
+
+  (define-integrable (make-section filename bytecount lines)
+    (cons (cons filename bytecount) lines))
+  (define-integrable section.filename caar)
+  (define-integrable section.bytecount cdar)
+  (define-integrable section.lines cdr)
+
+  (define headline-pattern
+    (compile-regsexp '(seq (line-start)
+                          (group filename (+ (char-not-in #\,)))
+                          #\,
+                          (group bytecount (+ (char-in numeric)))
+                          (line-end))))
+
+  (define (write-section section out)
+    (write-string "\f\n" out)
+    (write-string (string (section.filename section)
+                         #\, (section.bytecount section)
+                         "\n")
+                 out)
+    (for-each (lambda (line) (write-string line out) (newline out))
+             (section.lines section)))
+
+  (define (write-sections sections out)
+    (for-each (lambda (section) (write-section section out))
+             (sort sections
+                   (lambda (a b)
+                     (string<? (section.filename a)
+                               (section.filename b))))))
+
+  (define (read-section in)
+    (let loop ((lines '()))
+      (let ((line (read-line in)))
+       (if (or (eof-object? line)
+               (string=? line "\f"))
+           (reverse! lines)
+           (loop (cons line lines))))))
+
+  (define (rewriter in out)
+    (let ((line (read-line in)))
+      (cond ((eof-object? line)
+            (error "TAGS file is empty"))
+           ((not (string=? line "\f"))
+            (error "TAGS file does not start with a formfeed:" line))))
+    (let loop ((scms '()) (chs '()) (cdecls '()) (rest '()))
+      (let ((line (read-line in)))
+       (if (eof-object? line)
+           (begin
+             (write-sections scms out)
+             (write-sections chs out)
+             (write-sections rest out)
+             (write-sections cdecls out))
+           (let ((match (regsexp-match-string headline-pattern line)))
+             (if (not match)
+                 (error "TAGS file contains a bogus headline:" line))
+             (let ((filename (cdr (assq 'filename (cddr match))))
+                   (section (make-section (cdr (assq 'filename (cddr match)))
+                                          (cdr (assq 'bytecount (cddr match)))
+                                          (read-section in))))
+               (cond ((or (string-suffix? "-shim.c" filename)
+                          (string-suffix? "-const.c" filename))
+                      (loop scms chs cdecls rest))
+                     ((string-suffix? ".scm" filename)
+                      (loop (cons section scms) chs cdecls rest))
+                     ((or (string-suffix? ".c" filename)
+                          (string-suffix? ".h" filename))
+                      (loop scms (cons section chs) cdecls rest))
+                     ((string-suffix? ".cdecl" filename)
+                      (loop scms chs (cons section cdecls) rest))
+                     (else
+                      (loop scms chs cdecls (cons section rest))))))))))
+
+  (parameterize ((param:suppress-loading-message? #t))
+    (load-option 'ffi))
+  ((access rewrite-file (->environment '(ffi build)))
+   (merge-pathnames "TAGS")
+   rewriter))
 EOF
index e83316cd6a0bab8dc0131ca3b9cf7b0f3e9103ff..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -4,8 +4,6 @@
 # Changes to TAGS:
 #   + Punt any generated *-shim.c and *-const.c files.
 #   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
-# Someday:
-#   + Index the .cdecls?
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
@@ -87,5 +85,5 @@ ${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
     (load-option 'ffi))
   ((access rewrite-file (->environment '(ffi build)))
    (merge-pathnames "TAGS")
-   rewriter)))
+   rewriter))
 EOF
index 0d8c9988668b08acec9abe6a2ad637176d543707..36b5ae79fc53da4019ef736a306a208377f51b4d 100644 (file)
@@ -87,7 +87,7 @@ TESTS = pango-check.sh
 
 tags: tags-am $(sources) $(cdecls)
        $(ETAGS) -a $(sources) -r '/^([^iI].*/' $(cdecls)
-       ./tags-fix.sh pango
+       ./tags-fix.sh
 
 EXTRA_DIST += $(sources) $(cdecls) compile.sh pango.pkg
 EXTRA_DIST += pango-check.sh
index 2a8ec6437fedc1defb743faba774b9a143f1d27f..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -1,42 +1,89 @@
 #!/bin/sh
 # -*-Scheme-*-
 #
-# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+# Changes to TAGS:
+#   + Punt any generated *-shim.c and *-const.c files.
+#   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
-${MIT_SCHEME_EXE} --batch-mode -- "${@}" <<\EOF
-(let ((name (car (command-line-arguments))))
-  (let ((shim.c-prefix (string-append name "-shim.c,"))
-       (const.c-prefix (string-append name "-const.c,")))
-
-    (define (rewriter in out)
-      (let loop ((skipping? #f))
-       (let ((line (read-line in)))
-         (cond ((eof-object? line)
-                unspecific)
-               ((string=? line "\f")
-                (let ((next (read-line in)))
-                  (cond ((eof-object? next) (error "Bogus TAGS format:" next))
-                        ((or (string-prefix? shim.c-prefix next)
-                             (string-prefix? const.c-prefix next))
-                         (loop #t))
-                        (else
-                         (write-string line out)
-                         (newline out)
-                         (write-string next out)
-                         (newline out)
-                         (loop #f)))))
-               (skipping?
-                (loop skipping?))
-               (else
-                (write-string line out)
-                (newline out)
-                (loop skipping?))))))
-
-    (parameterize ((param:suppress-loading-message? #t))
-      (load-option 'ffi))
-    ((access rewrite-file (->environment '(ffi build)))
-     (merge-pathnames "TAGS")
-     rewriter)))
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ()
+
+  (define-integrable (make-section filename bytecount lines)
+    (cons (cons filename bytecount) lines))
+  (define-integrable section.filename caar)
+  (define-integrable section.bytecount cdar)
+  (define-integrable section.lines cdr)
+
+  (define headline-pattern
+    (compile-regsexp '(seq (line-start)
+                          (group filename (+ (char-not-in #\,)))
+                          #\,
+                          (group bytecount (+ (char-in numeric)))
+                          (line-end))))
+
+  (define (write-section section out)
+    (write-string "\f\n" out)
+    (write-string (string (section.filename section)
+                         #\, (section.bytecount section)
+                         "\n")
+                 out)
+    (for-each (lambda (line) (write-string line out) (newline out))
+             (section.lines section)))
+
+  (define (write-sections sections out)
+    (for-each (lambda (section) (write-section section out))
+             (sort sections
+                   (lambda (a b)
+                     (string<? (section.filename a)
+                               (section.filename b))))))
+
+  (define (read-section in)
+    (let loop ((lines '()))
+      (let ((line (read-line in)))
+       (if (or (eof-object? line)
+               (string=? line "\f"))
+           (reverse! lines)
+           (loop (cons line lines))))))
+
+  (define (rewriter in out)
+    (let ((line (read-line in)))
+      (cond ((eof-object? line)
+            (error "TAGS file is empty"))
+           ((not (string=? line "\f"))
+            (error "TAGS file does not start with a formfeed:" line))))
+    (let loop ((scms '()) (chs '()) (cdecls '()) (rest '()))
+      (let ((line (read-line in)))
+       (if (eof-object? line)
+           (begin
+             (write-sections scms out)
+             (write-sections chs out)
+             (write-sections rest out)
+             (write-sections cdecls out))
+           (let ((match (regsexp-match-string headline-pattern line)))
+             (if (not match)
+                 (error "TAGS file contains a bogus headline:" line))
+             (let ((filename (cdr (assq 'filename (cddr match))))
+                   (section (make-section (cdr (assq 'filename (cddr match)))
+                                          (cdr (assq 'bytecount (cddr match)))
+                                          (read-section in))))
+               (cond ((or (string-suffix? "-shim.c" filename)
+                          (string-suffix? "-const.c" filename))
+                      (loop scms chs cdecls rest))
+                     ((string-suffix? ".scm" filename)
+                      (loop (cons section scms) chs cdecls rest))
+                     ((or (string-suffix? ".c" filename)
+                          (string-suffix? ".h" filename))
+                      (loop scms (cons section chs) cdecls rest))
+                     ((string-suffix? ".cdecl" filename)
+                      (loop scms chs (cons section cdecls) rest))
+                     (else
+                      (loop scms chs cdecls (cons section rest))))))))))
+
+  (parameterize ((param:suppress-loading-message? #t))
+    (load-option 'ffi))
+  ((access rewrite-file (->environment '(ffi build)))
+   (merge-pathnames "TAGS")
+   rewriter))
 EOF
index e83316cd6a0bab8dc0131ca3b9cf7b0f3e9103ff..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -4,8 +4,6 @@
 # Changes to TAGS:
 #   + Punt any generated *-shim.c and *-const.c files.
 #   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
-# Someday:
-#   + Index the .cdecls?
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
@@ -87,5 +85,5 @@ ${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
     (load-option 'ffi))
   ((access rewrite-file (->environment '(ffi build)))
    (merge-pathnames "TAGS")
-   rewriter)))
+   rewriter))
 EOF
index e83316cd6a0bab8dc0131ca3b9cf7b0f3e9103ff..6fda030bfbc54eb7b7d24bc8b8e6791dc5e26958 100755 (executable)
@@ -4,8 +4,6 @@
 # Changes to TAGS:
 #   + Punt any generated *-shim.c and *-const.c files.
 #   + Re-order the files: .scm first, .[hc] next, whatnot, and .cdecls last.
-# Someday:
-#   + Index the .cdecls?
 
 set -e
 : ${MIT_SCHEME_EXE=mit-scheme}
@@ -87,5 +85,5 @@ ${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
     (load-option 'ffi))
   ((access rewrite-file (->environment '(ffi build)))
    (merge-pathnames "TAGS")
-   rewriter)))
+   rewriter))
 EOF