From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Thu, 25 Jul 2019 20:48:51 +0000 (-0500)
Subject: New tags-fix.sh for every plugin.
X-Git-Tag: mit-scheme-pucked-10.1.12~6
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=700d4d5cb289d4d2d15642aa349400c5a998012f;p=mit-scheme.git

New tags-fix.sh for every plugin.
---

diff --git a/src/blowfish/tags-fix.sh b/src/blowfish/tags-fix.sh
index e83316cd6..6fda030bf 100755
--- a/src/blowfish/tags-fix.sh
+++ b/src/blowfish/tags-fix.sh
@@ -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
diff --git a/src/cairo/Makefile.am b/src/cairo/Makefile.am
index 9c010b13a..023d843ea 100644
--- a/src/cairo/Makefile.am
+++ b/src/cairo/Makefile.am
@@ -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
diff --git a/src/cairo/tags-fix.sh b/src/cairo/tags-fix.sh
index aee615c48..6fda030bf 100755
--- a/src/cairo/tags-fix.sh
+++ b/src/cairo/tags-fix.sh
@@ -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
diff --git a/src/gdbm/tags-fix.sh b/src/gdbm/tags-fix.sh
index e83316cd6..6fda030bf 100755
--- a/src/gdbm/tags-fix.sh
+++ b/src/gdbm/tags-fix.sh
@@ -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
diff --git a/src/gl/Makefile.am b/src/gl/Makefile.am
index 71e2c3f19..5fd9e48a7 100644
--- a/src/gl/Makefile.am
+++ b/src/gl/Makefile.am
@@ -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
diff --git a/src/gl/tags-fix.sh b/src/gl/tags-fix.sh
index 2a8ec6437..6fda030bf 100755
--- a/src/gl/tags-fix.sh
+++ b/src/gl/tags-fix.sh
@@ -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
diff --git a/src/glib/Makefile.am b/src/glib/Makefile.am
index 1a0fbd252..1b2f8be29 100644
--- a/src/glib/Makefile.am
+++ b/src/glib/Makefile.am
@@ -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
diff --git a/src/glib/tags-fix.sh b/src/glib/tags-fix.sh
index aee615c48..6fda030bf 100755
--- a/src/glib/tags-fix.sh
+++ b/src/glib/tags-fix.sh
@@ -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
diff --git a/src/gtk/Makefile.am b/src/gtk/Makefile.am
index 322fcc151..bb4effecf 100644
--- a/src/gtk/Makefile.am
+++ b/src/gtk/Makefile.am
@@ -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
diff --git a/src/gtk/tags-fix.sh b/src/gtk/tags-fix.sh
index 2a8ec6437..6fda030bf 100755
--- a/src/gtk/tags-fix.sh
+++ b/src/gtk/tags-fix.sh
@@ -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
diff --git a/src/mcrypt/tags-fix.sh b/src/mcrypt/tags-fix.sh
index e83316cd6..6fda030bf 100755
--- a/src/mcrypt/tags-fix.sh
+++ b/src/mcrypt/tags-fix.sh
@@ -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
diff --git a/src/pango/Makefile.am b/src/pango/Makefile.am
index 0d8c99886..36b5ae79f 100644
--- a/src/pango/Makefile.am
+++ b/src/pango/Makefile.am
@@ -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
diff --git a/src/pango/tags-fix.sh b/src/pango/tags-fix.sh
index 2a8ec6437..6fda030bf 100755
--- a/src/pango/tags-fix.sh
+++ b/src/pango/tags-fix.sh
@@ -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
diff --git a/src/pgsql/tags-fix.sh b/src/pgsql/tags-fix.sh
index e83316cd6..6fda030bf 100755
--- a/src/pgsql/tags-fix.sh
+++ b/src/pgsql/tags-fix.sh
@@ -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
diff --git a/src/x11/tags-fix.sh b/src/x11/tags-fix.sh
index e83316cd6..6fda030bf 100755
--- a/src/x11/tags-fix.sh
+++ b/src/x11/tags-fix.sh
@@ -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