[Emacs-diffs] /srv/bzr/emacs/emacs-24 r107979: Improve tbl support in woman.el.

[Chong Yidong]

------------------------------------------------------------
revno: 107979
fixes bug: http://debbugs.gnu.org/5635
author: Michael Vehrs <address@hidden>
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2012-04-21 13:54:39 +0800
message:
  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 ?\ .
modified:
  lisp/ChangeLog
  lisp/woman.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-04-20 19:56:59 +0000
+++ b/lisp/ChangeLog    2012-04-21 05:54:39 +0000
@@ -1,3 +1,20 @@
+2012-04-21  Michael Vehrs  <address@hidden>
+
+       * 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  <address@hidden>
+
+       * 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  <address@hidden>
 
        * minibuffer.el (completion-file-name-table): Complete user names.

=== modified file 'lisp/woman.el'
--- a/lisp/woman.el     2012-04-16 18:46:46 +0000
+++ b/lisp/woman.el     2012-04-21 05:54:39 +0000
@@ -2133,7 +2133,7 @@
            (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 @@
        (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 @@
            ;; 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 @@
 ;; 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 @@
                              (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 @@
       (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 @@
       ;; 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 @@
                   (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 (- 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 @@
   (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 @@
 (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 @@
     (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 @@
        (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 @@
   ;; ".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 @@
         (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))))