From e510871adb4248e438ec556c0a4765910423b0d4 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 22 Oct 1991 10:48:44 +0000
Subject: [PATCH] Improve NUKE-NROFF-BS a little more: speed up nuke loops,
 generalize header pattern to handle hyphens within section number, simplify
 nuking of blank lines at buffer start.

---
 v7/src/edwin/manual.scm | 86 ++++++++++++++++++++---------------------
 1 file changed, 43 insertions(+), 43 deletions(-)

diff --git a/v7/src/edwin/manual.scm b/v7/src/edwin/manual.scm
index 10c8f185f..ae2ac4d7a 100644
--- a/v7/src/edwin/manual.scm
+++ b/v7/src/edwin/manual.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/manual.scm,v 1.4 1991/10/21 12:49:45 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/manual.scm,v 1.5 1991/10/22 10:48:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -120,50 +120,50 @@ where SECTION is the desired section of the manual, as in `tty(4)'."
 
 (define (nuke-nroff-bs buffer)
   (let* ((group (buffer-group buffer))
-	 (syntax-table (group-syntax-table group))
-	 (nuke-regexp
-	  (lambda (regexp case-fold-search replacement)
-	    (let ((pattern (re-compile-pattern regexp case-fold-search)))
-	      (let loop ((index (group-start-index group)))
-		(if (re-search-buffer-forward pattern
-					      case-fold-search
-					      syntax-table
-					      group
-					      index
-					      (group-end-index group))
-		    (begin
-		      (replace-match replacement false true)
-		      (loop (re-match-start-index 0)))))))))
-    ;; Nuke underlining and overstriking
-    (nuke-regexp "\\(_\b\\)+" false "")
-    (nuke-regexp "\\(\b.\\)+" false "")
-    ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
-    (nuke-regexp "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" false "")
-    ;; Nuke footers: "Printed 12/3/85	27 April 1981	1"
-    (nuke-regexp manual-vendor-pattern true "")
-    (nuke-regexp "^\\([A-Za-z0-9_]+\\|\\)[ \t]*[0-9]+$" false "")
+	 (syntax-table (group-syntax-table group)))
+    (let ((nuke-regexp
+	   (lambda (regexp case-fold-search)
+	     (let ((pattern (re-compile-pattern regexp case-fold-search)))
+	       (let loop ((index (group-start-index group)))
+		 (if (re-search-buffer-forward pattern
+					       case-fold-search
+					       syntax-table
+					       group
+					       index
+					       (group-end-index group))
+		     (loop (mark-index (delete-match)))))))))
+      ;; Nuke underlining
+      (nuke-regexp "\\(_\b\\)+" false)
+      ;; Nuke overstriking
+      (nuke-regexp "\\(\b.\\)+" false)
+      ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
+      (nuke-regexp "^ *\\([A-Za-z][-_A-Za-z0-9]*([-0-9A-Z]+)\\).*\\1$" false)
+      ;; Nuke vendor-specific footers
+      (nuke-regexp manual-vendor-pattern true)
+      ;; Nuke generic footers
+      (nuke-regexp "^[A-Za-z0-9_]*[ \t]*[0-9]+$" false))
     ;; Crunch blank lines
-    (nuke-regexp "\n\n\n\n*" false "\n\n"))
+    (let ((pattern (re-compile-pattern "\n\n\n+" false)))
+      (let loop ((index (group-start-index group)))
+	(if (re-search-buffer-forward pattern
+				      false
+				      syntax-table
+				      group
+				      index
+				      (group-end-index group))
+	    (loop (mark-index (replace-match "\n\n" false true)))))))
   ;; Nuke blanks lines at start.
-  (let ((start (buffer-start buffer)))
-    (let ((delete-blanks
-	   (lambda ()
-	     (if (line-blank? start)
-		 (delete-string start
-				(let loop ((mark start))
-				  (let ((m (line-start mark 1 false)))
-				    (cond ((not m) (line-end mark 0))
-					  ((not (line-blank? m)) m)
-					  (else (loop m))))))))))
-      (delete-blanks)
-      ;; Also get "Reformatting page" message if any.
-      (if (re-match-forward "^Reformatting page"
-			    start
-			    (buffer-end buffer)
-			    false)
-	  (begin
-	    (delete-string start (line-end start 0))
-	    (delete-blanks)))))
+  (if (re-match-forward "\\([ \t]*\n\\)+"
+			(buffer-start buffer)
+			(buffer-end buffer)
+			false)
+      (delete-match))
+  ;; Nuke "Reformatting page" message, plus trailing blank lines.
+  (if (re-match-forward "Reformatting page.*\n\\([ \t]*\n\\)*"
+			(buffer-start buffer)
+			(buffer-end buffer)
+			false)
+      (delete-match))
   ;; Nuke blanks lines at end.
   (let ((end (buffer-end buffer)))
     (if (line-blank? (line-start end 0))
-- 
2.25.1