Improve tbl support in woman.el.

* lisp/woman.el (woman-find-next-control-line): New arg, specifying an
additional regexp component for the control line.
(woman2-roff-buffer): Use it.
(woman-break-table): New function.
(woman2-TS): Use it.

And some cleanups:

* lisp/woman.el (woman-set-buffer-display-table, woman-decode-region)
(woman-horizontal-escapes, woman-negative-vertical-space)
(woman-tab-to-tab-stop, woman2-fc, woman2-TS)
(WoMan-warn-ignored): Use ?\s instead of ?\ .

Fixes: debbugs:5635

1 files changed, 73 insertions, 24 deletions

diff --git a/lisp/woman.el b/lisp/woman.el
index 98ab27716a1..3ab06a5dd73 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -2133,7 +2133,7 @@ European characters."
 	    (copy-sequence standard-display-table)
 	  (make-display-table)))
   ;; Display the following internal chars correctly:
-  (aset buffer-display-table woman-unpadded-space-char [?\ ])
+  (aset buffer-display-table woman-unpadded-space-char [?\s])
   (aset buffer-display-table woman-escaped-escape-char [?\\]))
 
 
@@ -2393,10 +2393,12 @@ Currently set only from '\" t in the first line of the source file.")
 	(progn
 	  (goto-char from)
 	  (while (search-forward woman-escaped-escape-string nil t)
-	    (delete-char -1) (insert ?\\))
+	    (delete-char -1)
+	    (insert ?\\))
 	  (goto-char from)
 	  (while (search-forward woman-unpadded-space-string nil t)
-	    (delete-char -1) (insert ?\ ))))
+	    (delete-char -1)
+	    (insert ?\s))))
 
     ;; Must return the new end of file if used in format-alist.
     (point-max)))
@@ -2437,9 +2439,9 @@ Preserves location of `point'."
 	    ;; first backwards then forwards:
 	    (while (and
 		    (<= (setq N (1+ N)) 0)
-		    (cond ((memq (preceding-char) '(?\  ?\t))
+		    (cond ((memq (preceding-char) '(?\s ?\t))
 			   (delete-char -1) t)
-			  ((memq (following-char) '(?\  ?\t))
+			  ((memq (following-char) '(?\s ?\t))
 			   (delete-char 1) t)
 			  (t nil))))
 	    (if (<= N 0)
@@ -3376,7 +3378,7 @@ Ignore the default face and underline only word characters."
 ;; this used to be globally bound to nil, to avoid an error.  Instead
 ;; we can use bound-and-true-p in woman-translate.
 (defvar woman-translations)
-;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
+;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\s)) or nil.
 
 (defun woman-get-next-char ()
   "Return and delete next char in buffer, including special chars."
@@ -3711,7 +3713,9 @@ expression in parentheses.  Leaves point after the value."
                              (setq fn 'woman2-format-paragraphs))))
                ()
              ;; Find next control line:
-             (set-marker to (woman-find-next-control-line))
+	     (if (equal woman-request "TS")
+		 (set-marker to (woman-find-next-control-line "TE"))
+	       (set-marker to (woman-find-next-control-line)))
              ;; Call the appropriate function:
              (funcall fn to)))
       (if (not (eobp))			; This should not happen, but ...
@@ -3722,12 +3726,13 @@ expression in parentheses.  Leaves point after the value."
       (fset 'insert-and-inherit insert-and-inherit)
       (set-marker to nil))))
 
-(defun woman-find-next-control-line ()
-  "Find and return start of next control line."
-;  (let ((to (save-excursion
-;	      (re-search-forward "^\\." nil t))))
-;    (if to (1- to) (point-max)))
-  (let (to)
+(defun woman-find-next-control-line (&optional pat)
+  "Find and return start of next control line.
+PAT, if non-nil, specifies an additional component of the control
+line regexp to search for, which is appended to the default
+regexp, \"\\(\\\\c\\)?\\n[.']\"."
+  (let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat))
+        to)
     (save-excursion
       ;; Must handle
       ;; ...\c
@@ -3736,12 +3741,14 @@ expression in parentheses.  Leaves point after the value."
       ;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!!
       (while
 	  (and
-	   (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
+	   (setq to (re-search-forward pattern nil t))
 	   (match-beginning 1)
 	   (looking-at "br"))
 	(goto-char (match-beginning 0))
 	(woman-delete-line 2)))
-    (if to (1- to) (point-max))))
+    (if to
+	(- to (+ 1 (length pat)))
+      (point-max))))
 
 (defun woman2-PD (to)
   ".PD d -- Set the interparagraph distance to d.
@@ -3885,18 +3892,18 @@ Leave 1 blank line.  Format paragraphs upto TO."
 		   (insert (substring overlap i eol))
 		   (setq i (or eol imax)))
 		 )
-		((eq c ?\ )		; skip
+		((eq c ?\s)		; skip
 		 (forward-char))
 		((eq c ?\t)		; skip
 		 (if (eq (following-char) ?\t)
 		     (forward-char)	; both tabs, just skip
 		   (dotimes (i woman-tab-width)
                      (if (eolp)
-                         (insert ?\ )	; extend line
+                         (insert ?\s)	; extend line
                        (forward-char)) ; skip
 		     )))
 		(t
-		 (if (or (eq (following-char) ?\ ) ; overwrite OK
+		 (if (or (eq (following-char) ?\s) ; overwrite OK
 			 overwritten) ; warning only once per ".sp -"
 		     ()
 		   (setq overwritten t)
@@ -4400,7 +4407,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C."
 		    tab (- tab (if (eq type ?C) (/ n 2) n))) )
 	  (setq n (- tab (current-column)))
 	  (insert-char ?\s n))
-      (insert ?\ ))))
+      (insert ?\s))))
 
 (defun woman2-DT (to)
   ".DT -- Restore default tabs.  Format paragraphs upto TO.
@@ -4418,7 +4425,7 @@ Needs doing properly!"
   (if (eolp)
       (woman-delete-whole-line)		; ignore!
     (let ((delim (following-char))
-	  (pad ?\ ) end)		; pad defaults to space
+	  (pad ?\s) end)		; pad defaults to space
       (forward-char)
       (skip-chars-forward " \t")
       (or (eolp) (setq pad (following-char)))
@@ -4449,8 +4456,6 @@ Needs doing properly!"
 (defun woman2-TS (to)
   ".TS -- Start of table code for the tbl processor.
 Format paragraphs upto TO."
-  ;; This is a preliminary hack that seems to suffice for lilo.8.
-  (woman-delete-line 1)			; ignore any arguments
   (when woman-emulate-tbl
     ;; Assumes column separator is \t and intercolumn spacing is 3.
     ;; The first line may optionally be a list of options terminated by
@@ -4462,6 +4467,22 @@ Format paragraphs upto TO."
     (woman-delete-line 1)
     ;; For each column, find its width and align it:
     (let ((start (point)) (col 1))
+      (WoMan-log "%s" (buffer-substring start (+ start 40)))
+      ;; change T{ T} to tabs
+      (while (search-forward "T{\n" to t)
+	(replace-match "")
+	(catch 'end
+	  (while (search-forward "\n" to t)
+	    (replace-match " ")
+	    (if (looking-at "T}")
+		(progn
+		  (delete-char 2)
+		  (throw 'end t))))))
+      (goto-char start)
+      ;; strip space and headers
+      (while (re-search-forward "^\\.TH\\|\\.sp" to t)
+	(woman-delete-whole-line))
+      (goto-char start)
       (while (prog1 (search-forward "\t" to t) (goto-char start))
 	;; Find current column width:
 	(while (< (point) to)
@@ -4475,8 +4496,25 @@ Format paragraphs upto TO."
 	(while (< (point) to)
 	  (when (search-forward "\t" to t)
 	    (delete-char -1)
-	    (insert-char ?\  (- col (current-column))))
+	    (insert-char ?\s (- col (current-column))))
 	  (forward-line))
+	(goto-char start))
+      ;; find maximum width
+      (let ((max-col 0))
+	(while (search-forward "\n" to t)
+	  (backward-char)
+	  (if (> (current-column) max-col)
+	      (setq max-col (current-column)))
+	  (forward-char))
+	(goto-char start)
+	;; break lines if they are too long
+	(when (and (> max-col woman-fill-column)
+		   (> woman-fill-column col))
+	  (setq max-col woman-fill-column)
+	  (woman-break-table col to start)
+	  (goto-char start))
+	(while (re-search-forward "^_$" to t)
+	  (replace-match (make-string max-col ?_)))
 	(goto-char start))))
   ;; Format table with no filling or adjusting (cf. woman2-nf):
   (setq woman-nofill t)
@@ -4486,6 +4524,17 @@ Format paragraphs upto TO."
   ;; ".TE -- End of table code for the tbl processor."
   ;; Turn filling and adjusting back on.
 
+(defun woman-break-table (start-column to start)
+  (while (< (point) to)
+    (move-to-column woman-fill-column)
+    (if (eolp)
+	(forward-line)
+      (if (and (search-backward " " start t)
+	       (> (current-column) start-column))
+	  (progn
+	    (insert-char ?\n 1)
+	    (insert-char ?\s (- start-column 5)))
+	(forward-line)))))
 
 ;;; WoMan message logging:
 
@@ -4523,7 +4572,7 @@ IGNORED is a string appended to the log message."
 	 (buffer-substring (point)
 			   (line-end-position))))
     (if (and (> (length tail) 0)
-	     (/= (string-to-char tail) ?\ ))
+	     (/= (string-to-char tail) ?\s))
 	(setq tail (concat " " tail)))
     (WoMan-log-1
      (concat "**  " request tail "  request " ignored))))