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

2 files changed, 90 insertions, 24 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 132aee66a9f..004a52c8d36 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2012-04-21  Michael Vehrs  <Michael.Burschik@gmx.de>
+
+        * woman.el: Add support for "T{ T}" tbl syntax, and fix the
+        filling of the last column of a table (Bug#5635).
+        (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.
+
+2012-04-21  Chong Yidong  <cyd@gnu.org>
+
+        * 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 ?\ .
+
 2012-04-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * minibuffer.el (completion-file-name-table): Complete user names.
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))))