utils/ptexinfmt.el

   1 ;;; ptexinfmt.el -- portable Texinfo formatter.
   2
   3 ;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993,
   4 ;;               1994, 1995, 1996, 1997 Free Software Foundation, Inc.
   5 ;; Copyright (C) 1999 Yoshiki Hayashi <yoshiki@xemacs.org>
   6 ;; Copyright (C) 2000 TAKAHASHI Kaoru <kaoru@kaisei.org>
   7
   8 ;; Author: TAKAHASHI Kaoru <kaoru@kaisei.org>
   9 ;;      Yoshiki Hayashi <yoshiki@xemacs.org>
  10 ;; Maintainer: TAKAHASHI Kaoru <kaoru@kaisei.org>
  11 ;; Created: 7 Jul 2000
  12 ;; Keywords: maint, tex, docs, emulation, compatibility
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; Original code: Yoshiki Hayashi <yoshiki@xemacs.org>
  32 ;;      makeinfo.el (gnujdoc project)
  33
  34 ;; Support texinfmt.el 2.32 or later.
  35
  36 ;;; Code:
  37 (require 'texinfmt)
  38 (require 'poe)
  39 (require 'broken)
  40
  41 (provide 'ptexinfmt)
  42
  43 ;;; Broken
  44 (defvar ptexinfmt-disable-broken-notice-flag t
  45   "If non-nil disable notice, when call `broken-facility'.
  46 This is NO-NOTICE argument in `broken-facility'.")
  47
  48 ;; sort -fd
  49 (broken-facility texinfo-format-printindex
  50   "Can't sort on Mule for Windows."
  51   (if (and (memq system-type '(windows-nt ms-dos))
  52 ;;; I don't know version threshold.
  53 ;;;        (string< texinfmt-version "2.37 of 24 May 1997")
  54            (boundp 'MULE) (not (featurep 'meadow))) ; Mule for Windows
  55       nil
  56     t)
  57   ptexinfmt-disable-broken-notice-flag)
  58
  59 ;; @var
  60 (broken-facility texinfo-format-var
  61   "Don't perse @var argument."
  62   (condition-case nil
  63       (with-temp-buffer
  64         (let (texinfo-enclosure-list texinfo-alias-list)
  65           (texinfo-mode)
  66           (insert "@var{@asis{foo}}\n")
  67           (texinfo-format-expand-region (point-min) (point-max))
  68           t))
  69     (error nil))
  70   ptexinfmt-disable-broken-notice-flag)
  71
  72 ;; @xref
  73 (broken-facility texinfo-format-xref
  74   "Can't format @xref, 1st argument is empty."
  75   (condition-case nil
  76       (with-temp-buffer
  77         (let (texinfo-enclosure-list texinfo-alias-list)
  78           (texinfo-mode)
  79           (insert "@xref{, xref, , file}\n")
  80           (texinfo-format-expand-region (point-min) (point-max))
  81           t))
  82     (error nil))
  83   ptexinfmt-disable-broken-notice-flag)
  84
  85 ;; @uref
  86 (broken-facility texinfo-format-uref
  87   "Parse twice @uref argument."
  88   (condition-case nil
  89       (with-temp-buffer
  90         (let (texinfo-enclosure-list texinfo-alias-list)
  91           (texinfo-mode)
  92           (insert "@uref{mailto:foo@@bar.com}\n")
  93           (texinfo-format-expand-region (point-min) (point-max))
  94           t))
  95     (error nil))
  96   ptexinfmt-disable-broken-notice-flag)
  97
  98 ;; @multitable
  99 (broken-facility texinfo-multitable-widths
 100   "`texinfo-multitable-widths' unsupport wide-char."
 101   (if (fboundp 'texinfo-multitable-widths)
 102       (with-temp-buffer
 103         (let ((str "\e$BI}9-J8;z\e(B"))
 104           (texinfo-mode)
 105           (insert (format " {%s}\n" str))
 106           (goto-char (point-min))
 107           (if (= (car (texinfo-multitable-widths)) (length str))
 108               nil
 109             t)))
 110     ;; function definition is void
 111     t)
 112   ptexinfmt-disable-broken-notice-flag)
 113
 114 (broken-facility texinfo-multitable-item
 115   "`texinfo-multitable-item' unsupport wide-char."
 116   (if-broken texinfo-multitable-widths nil t)
 117   ptexinfmt-disable-broken-notice-flag)
 118
 119
 120 ;;; Obsolete
 121 ;; Removed Texinfo 3.8
 122 (put 'overfullrule 'texinfo-format 'texinfo-discard-line)
 123 (put 'smallbreak 'texinfo-format 'texinfo-discard-line)
 124 (put 'medbreak 'texinfo-format 'texinfo-discard-line)
 125 (put 'bigbreak 'texinfo-format 'texinfo-discard-line)
 126 ;; Removed Texinfo 3.9
 127 (put 'setchapterstyle 'texinfo-format 'texinfo-discard-line-with-args)
 128
 129 ;;; Hardcopy and HTML (discard)
 130 ;; I18N
 131 (put 'documentlanguage 'texinfo-format 'texinfo-discard-line-with-args)
 132 (put 'documentencoding 'texinfo-format 'texinfo-discard-line-with-args)
 133
 134 ;; size
 135 (put 'smallbook 'texinfo-format 'texinfo-discard-line)
 136 (put 'letterpaper 'texinfo-format 'texinfo-discard-line)
 137 (put 'afourpaper 'texinfo-format 'texinfo-discard-line)
 138 (put 'afourlatex 'texinfo-format 'texinfo-discard-line)
 139 (put 'afourwide 'texinfo-format 'texinfo-discard-line)
 140 (put 'afivepaper 'texinfo-format 'texinfo-discard-line)
 141 (put 'pagesizes 'texinfo-format 'texinfo-discard-line-with-args)
 142
 143 ;; style
 144 (put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
 145 (put 'kbdinputstyle 'texinfo-format 'texinfo-discard-line-with-args)
 146
 147 ;; flags
 148 (put 'setcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
 149 (put 'setshortcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
 150 (put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args)
 151
 152 ;; head & foot
 153 (put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
 154 (put 'evenfooting 'texinfo-format 'texinfo-discard-line-with-args)
 155 (put 'evenheading 'texinfo-format 'texinfo-discard-line-with-args)
 156 (put 'oddfooting 'texinfo-format 'texinfo-discard-line-with-args)
 157 (put 'oddheading 'texinfo-format 'texinfo-discard-line-with-args)
 158 (put 'everyfooting 'texinfo-format 'texinfo-discard-line-with-args)
 159 (put 'everyheading 'texinfo-format 'texinfo-discard-line-with-args)
 160
 161 ;; misc
 162 (put 'page 'texinfo-format 'texinfo-discard-line)
 163 (put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
 164
 165
 166 \f
 167 ;;; Directory File
 168 ;; @direcategory
 169 (put 'dircategory 'texinfo-format 'texinfo-format-dircategory)
 170 (defun-maybe texinfo-format-dircategory ()
 171   (let ((str (texinfo-parse-arg-discard)))
 172     (delete-region (point)
 173                    (progn
 174                      (skip-chars-forward " ")
 175                      (point)))
 176     (insert "INFO-DIR-SECTION " str "\n")))
 177
 178 ;; @direntry
 179 (put 'direntry 'texinfo-format 'texinfo-format-direntry)
 180 (defun-maybe texinfo-format-direntry ()
 181   (texinfo-push-stack 'direntry nil)
 182   (texinfo-discard-line)
 183   (insert "START-INFO-DIR-ENTRY\n"))
 184
 185 (put 'direntry 'texinfo-end 'texinfo-end-direntry)
 186 (defun-maybe texinfo-end-direntry ()
 187   (texinfo-discard-command)
 188   (insert "END-INFO-DIR-ENTRY\n\n")
 189   (texinfo-pop-stack 'direntry))
 190
 191
 192 ;;; Block Enclosing and Conditional
 193 ;; @detailmenu ... @end detailmenu
 194 (put 'detailmenu 'texinfo-format 'texinfo-discard-line)
 195 (put 'detailmenu 'texinfo-end 'texinfo-discard-command)
 196
 197 ;; @smalldisplay ... @end smalldisplay
 198 (put 'smalldisplay 'texinfo-format 'texinfo-format-example)
 199 (put 'smalldisplay 'texinfo-end 'texinfo-end-example)
 200
 201 ;; @smallformat ... @end smallformat
 202 (put 'smallformat 'texinfo-format 'texinfo-format-flushleft)
 203 (put 'smallformat 'texinfo-end 'texinfo-end-flushleft)
 204
 205 ;; @ifnottex ... @end ifnottex
 206 (put 'ifnottex 'texinfo-format 'texinfo-discard-line)
 207 (put 'ifnottex 'texinfo-end 'texinfo-discard-command)
 208
 209 ;; @ifnothtml ... @end ifnothtml
 210 (put 'ifnothtml 'texinfo-format 'texinfo-discard-line)
 211 (put 'ifnothtml 'texinfo-end 'texinfo-discard-command)
 212
 213 ;; @ifnotinfo ... @end ifnotinfo
 214 (put 'ifnotinfo 'texinfo-format 'texinfo-format-ifnotinfo)
 215 (put 'endifnotinfo 'texinfo-format 'texinfo-discard-line)
 216 (defun-maybe texinfo-format-ifnotinfo ()
 217   (delete-region texinfo-command-start
 218                  (progn (re-search-forward "@end ifnotinfo[ \t]*\n")
 219                         (point))))
 220
 221 ;; @html ... @end html
 222 (put 'html 'texinfo-format 'texinfo-format-html)
 223 (put 'endhtml 'texinfo-format 'texinfo-discard-line)
 224 (defun-maybe texinfo-format-html ()
 225   (delete-region texinfo-command-start
 226                  (progn (re-search-forward "@end html[ \t]*\n")
 227                         (point))))
 228
 229
 230 \f
 231 ;;; Marking
 232 ;; @url, @env, @command
 233 (put 'url 'texinfo-format 'texinfo-format-code)
 234 (put 'env 'texinfo-format 'texinfo-format-code)
 235 (put 'command 'texinfo-format 'texinfo-format-code)
 236
 237 ;; @acronym
 238 (put 'acronym 'texinfo-format 'texinfo-format-var)
 239
 240 (when-broken texinfo-format-var
 241   (fmakunbound 'texinfo-format-var))
 242 (defun-maybe texinfo-format-var ()
 243   (let ((arg (texinfo-parse-expanded-arg)))
 244     (texinfo-discard-command)
 245     (insert (upcase arg))))
 246
 247 ;; @key
 248 (put 'key 'texinfo-format 'texinfo-format-key)
 249 (defun-maybe texinfo-format-key ()
 250   (insert (texinfo-parse-arg-discard))
 251   (goto-char texinfo-command-start))
 252
 253 ;; @email{EMAIL-ADDRESS[, DISPLAYED-TEXT]}
 254 (put 'email 'texinfo-format 'texinfo-format-email)
 255 (defun-maybe texinfo-format-email ()
 256   "Format EMAIL-ADDRESS and optional DISPLAYED-TXT.
 257 Insert < ... > around EMAIL-ADDRESS."
 258   (let ((args (texinfo-format-parse-args)))
 259   (texinfo-discard-command)
 260     ;; if displayed-text
 261     (if (nth 1 args)
 262         (insert (nth 1 args) " <" (nth 0 args) ">")
 263       (insert "<" (nth 0 args) ">"))))
 264
 265 ;; @option
 266 (put 'option 'texinfo-format 'texinfo-format-option)
 267 (defun texinfo-format-option ()
 268   "Insert ` ... ' around arg unless inside a table; in that case, no quotes."
 269   ;; `looking-at-backward' not available in v. 18.57, 20.2
 270   ;; searched-for character is a control-H
 271   (if (not (search-backward "\010"
 272                             (save-excursion (beginning-of-line) (point))
 273                             t))
 274       (insert "`" (texinfo-parse-arg-discard) "'")
 275     (insert (texinfo-parse-arg-discard)))
 276   (goto-char texinfo-command-start))
 277
 278
 279 \f
 280 ;;; Accents and Special characters
 281 ;; @pounds{}    ==>     #       Pounds Sterling
 282 (put 'pounds 'texinfo-format 'texinfo-format-pounds)
 283 (defun-maybe texinfo-format-pounds ()
 284   (texinfo-parse-arg-discard)
 285   (insert "#"))
 286
 287 ;; @OE{}        ==>     OE      French-OE-ligature
 288 (put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature)
 289 (defun-maybe texinfo-format-French-OE-ligature ()
 290   (insert "OE" (texinfo-parse-arg-discard))
 291   (goto-char texinfo-command-start))
 292
 293 ;; @oe{}        ==>     oe
 294 (put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature)
 295 (defun-maybe texinfo-format-French-oe-ligature () ; lower case
 296   (insert "oe" (texinfo-parse-arg-discard))
 297   (goto-char texinfo-command-start))
 298
 299 ;; @AA{}        ==>     AA      Scandinavian-A-with-circle
 300 (put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle)
 301 (defun-maybe texinfo-format-Scandinavian-A-with-circle ()
 302   (insert "AA" (texinfo-parse-arg-discard))
 303   (goto-char texinfo-command-start))
 304
 305 ;; @aa{}        ==>     aa
 306 (put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle)
 307 (defun-maybe texinfo-format-Scandinavian-a-with-circle () ; lower case
 308   (insert "aa" (texinfo-parse-arg-discard))
 309   (goto-char texinfo-command-start))
 310
 311 ;; @AE{}        ==>     AE      Latin-Scandinavian-AE
 312 (put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE)
 313 (defun-maybe texinfo-format-Latin-Scandinavian-AE ()
 314   (insert "AE" (texinfo-parse-arg-discard))
 315   (goto-char texinfo-command-start))
 316
 317 ;; @ae{}        ==>     ae
 318 (put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae)
 319 (defun-maybe texinfo-format-Latin-Scandinavian-ae () ; lower case
 320   (insert "ae" (texinfo-parse-arg-discard))
 321   (goto-char texinfo-command-start))
 322
 323 ;; @ss{}        ==>     ss      German-sharp-S
 324 (put 'ss 'texinfo-format 'texinfo-format-German-sharp-S)
 325 (defun-maybe texinfo-format-German-sharp-S ()
 326   (insert "ss" (texinfo-parse-arg-discard))
 327   (goto-char texinfo-command-start))
 328
 329 ;; @questiondown{}      ==>     ?       upside-down-question-mark
 330 (put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark)
 331 (defun-maybe texinfo-format-upside-down-question-mark ()
 332   (insert "?" (texinfo-parse-arg-discard))
 333   (goto-char texinfo-command-start))
 334
 335 ;; @exclamdown{}        ==>     !       upside-down-exclamation-mark
 336 (put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark)
 337 (defun-maybe texinfo-format-upside-down-exclamation-mark ()
 338   (insert "!" (texinfo-parse-arg-discard))
 339   (goto-char texinfo-command-start))
 340
 341 ;; @L{}         ==>     L/      Polish suppressed-L (Lslash)
 342 (put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L)
 343 (defun-maybe texinfo-format-Polish-suppressed-L ()
 344   (insert (texinfo-parse-arg-discard) "/L")
 345   (goto-char texinfo-command-start))
 346
 347 ;; @l{}         ==>     l/      Polish suppressed-L (Lslash) (lower case)
 348 (put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case)
 349 (defun-maybe texinfo-format-Polish-suppressed-l-lower-case ()
 350   (insert (texinfo-parse-arg-discard) "/l")
 351   (goto-char texinfo-command-start))
 352
 353 ;; @O{}         ==>     O/      Scandinavian O-with-slash
 354 (put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash)
 355 (defun-maybe texinfo-format-Scandinavian-O-with-slash ()
 356   (insert (texinfo-parse-arg-discard) "O/")
 357   (goto-char texinfo-command-start))
 358
 359 ;; @o{}         ==>     o/      Scandinavian O-with-slash (lower case)
 360 (put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case)
 361 (defun-maybe texinfo-format-Scandinavian-o-with-slash-lower-case ()
 362   (insert (texinfo-parse-arg-discard) "o/")
 363   (goto-char texinfo-command-start))
 364
 365 ;; @,{c}        ==>     c,      cedilla accent
 366 (put ', 'texinfo-format 'texinfo-format-cedilla-accent)
 367 (defun-maybe texinfo-format-cedilla-accent ()
 368   (insert (texinfo-parse-arg-discard) ",")
 369   (goto-char texinfo-command-start))
 370
 371
 372 ;; @dotaccent{o}        ==>     .o      overdot-accent
 373 (put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent)
 374 (defun-maybe texinfo-format-overdot-accent ()
 375   (insert "." (texinfo-parse-arg-discard))
 376   (goto-char texinfo-command-start))
 377
 378 ;; @ubaraccent{o}       ==>     _o      underbar-accent
 379 (put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent)
 380 (defun-maybe texinfo-format-underbar-accent ()
 381   (insert "_" (texinfo-parse-arg-discard))
 382   (goto-char texinfo-command-start))
 383
 384 ;; @udotaccent{o}       ==>     o-.     underdot-accent
 385 (put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent)
 386 (defun-maybe texinfo-format-underdot-accent ()
 387   (insert (texinfo-parse-arg-discard) "-.")
 388   (goto-char texinfo-command-start))
 389
 390 ;; @H{o}        ==>     ""o     long Hungarian umlaut
 391 (put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut)
 392 (defun-maybe texinfo-format-long-Hungarian-umlaut ()
 393   (insert "\"\"" (texinfo-parse-arg-discard))
 394   (goto-char texinfo-command-start))
 395
 396 ;; @ringaccent{o}       ==>     *o      ring accent
 397 (put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent)
 398 (defun-maybe texinfo-format-ring-accent ()
 399   (insert "*" (texinfo-parse-arg-discard))
 400   (goto-char texinfo-command-start))
 401
 402 ;; @tieaccent{oo}       ==>     [oo     tie after accent
 403 (put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent)
 404 (defun-maybe texinfo-format-tie-after-accent ()
 405   (insert "[" (texinfo-parse-arg-discard))
 406   (goto-char texinfo-command-start))
 407
 408 ;; @u{o}        ==>     (o      breve accent
 409 (put 'u 'texinfo-format 'texinfo-format-breve-accent)
 410 (defun-maybe texinfo-format-breve-accent ()
 411   (insert "(" (texinfo-parse-arg-discard))
 412   (goto-char texinfo-command-start))
 413
 414 ;; @v{o}        ==>     <o      hacek accent
 415 (put 'v 'texinfo-format 'texinfo-format-hacek-accent)
 416 (defun-maybe texinfo-format-hacek-accent ()
 417   (insert "<" (texinfo-parse-arg-discard))
 418   (goto-char texinfo-command-start))
 419
 420 ;; @dotless{i}  ==>     i       dotless i and dotless j
 421 (put 'dotless 'texinfo-format 'texinfo-format-dotless)
 422 (defun-maybe texinfo-format-dotless ()
 423   (insert (texinfo-parse-arg-discard))
 424   (goto-char texinfo-command-start))
 425
 426
 427 \f
 428 ;;; Cross References
 429 ;; @ref, @xref
 430 (put 'ref 'texinfo-format 'texinfo-format-xref)
 431
 432 (when-broken texinfo-format-xref
 433   (fmakunbound 'texinfo-format-xref))
 434 (defun-maybe texinfo-format-xref ()
 435   (let ((args (texinfo-format-parse-args)))
 436     (texinfo-discard-command)
 437     (insert "*Note ")
 438     (let ((fname (or (nth 1 args) (nth 2 args))))
 439       (if (null (or fname (nth 3 args)))
 440           (insert (nth 0 args) "::")
 441         (insert (or fname (nth 0 args)) ": ")
 442         (if (nth 3 args)
 443             (insert "(" (nth 3 args) ")"))
 444         (unless (null (nth 0 args))
 445           (insert (nth 0 args)))))))
 446
 447 ;; @uref
 448 (put 'uref 'texinfo-format 'texinfo-format-uref)
 449 (when-broken texinfo-format-uref
 450   (fmakunbound 'texinfo-format-uref))
 451 (defun-maybe texinfo-format-uref ()
 452   "Format URL and optional URL-TITLE.
 453 Insert ` ... ' around URL if no URL-TITLE argument;
 454 otherwise, insert URL-TITLE followed by URL in parentheses."
 455   (let ((args (texinfo-format-parse-args)))
 456     (texinfo-discard-command)
 457     ;; if url-title
 458     (if (nth 1 args)
 459         (insert  (nth 1 args) " (" (nth 0 args) ")")
 460       (insert "`" (nth 0 args) "'"))))
 461
 462
 463 \f
 464 ;;; New command definition
 465 ;; @alias NEW=EXISTING
 466 (put 'alias 'texinfo-format 'texinfo-alias)
 467 (defun-maybe texinfo-alias ()
 468   (let ((start (1- (point)))
 469         args)
 470     (skip-chars-forward " ")
 471     (save-excursion (end-of-line) (setq texinfo-command-end (point)))
 472     (if (not (looking-at "\\([^=]+\\)=\\(.*\\)"))
 473         (error "Invalid alias command")
 474       (setq texinfo-alias-list
 475             (cons
 476              (cons
 477               (buffer-substring (match-beginning 1) (match-end 1))
 478               (buffer-substring (match-beginning 2) (match-end 2)))
 479              texinfo-alias-list))
 480       (texinfo-discard-command))))
 481
 482 ;; @definfoenclose NEWCMD, BEFORE, AFTER
 483
 484
 485 \f
 486 ;;; Special
 487 ;; @image{FILENAME, [WIDTH], [HEIGHT]}
 488 (put 'image 'texinfo-format 'texinfo-format-image)
 489 (defun-maybe texinfo-format-image ()
 490   (let ((args (texinfo-format-parse-args)) ; parse FILENAME?
 491         filename)
 492     (when (null (nth 0 args))
 493       (error "Invalid image command"))
 494     (texinfo-discard-command)
 495     ;; makeinfo uses FILENAME.txt
 496     (setq filename (format "%s.txt" (nth 0 args)))
 497     (message "Reading included file: %s" filename)
 498     ;; verbatim for Info output
 499     (goto-char (+ (point) (cadr (insert-file-contents filename))))
 500     (message "Reading included file: %s...done" filename)))
 501
 502
 503 ;; @exampleindent
 504
 505
 506 \f
 507 ;;; @multitable ... @end multitable
 508 (defvar-maybe texinfo-extra-inter-column-width 0
 509   "*Number of extra spaces between entries (columns) in @multitable.")
 510
 511 (defvar-maybe texinfo-multitable-buffer-name "*multitable-temporary-buffer*")
 512 (defvar-maybe texinfo-multitable-rectangle-name "texinfo-multitable-temp-")
 513
 514 ;; These commands are defined in texinfo.tex for printed output.
 515 (put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args)
 516 (put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args)
 517 (put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args)
 518 (put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args)
 519
 520 (put 'multitable 'texinfo-format 'texinfo-multitable)
 521
 522 (defun-maybe texinfo-multitable ()
 523   "Produce multi-column tables."
 524
 525 ;; This function pushes information onto the `texinfo-stack'.
 526 ;; A stack element consists of:
 527 ;;   - type-of-command, i.e., multitable
 528 ;;   - the information about column widths, and
 529 ;;   - the position of texinfo-command-start.
 530 ;; e.g., ('multitable (1 2 3 4) 123)
 531 ;; The command line is then deleted.
 532   (texinfo-push-stack
 533    'multitable
 534    ;; push width information on stack
 535    (texinfo-multitable-widths))
 536   (texinfo-discard-line-with-args))
 537
 538 (put 'multitable 'texinfo-end 'texinfo-end-multitable)
 539 (defun-maybe texinfo-end-multitable ()
 540   "Discard the @end multitable line and pop the stack of multitable."
 541   (texinfo-discard-command)
 542   (texinfo-pop-stack 'multitable))
 543
 544 (when-broken texinfo-multitable-widths
 545   (fmakunbound 'texinfo-multitable-widths))
 546
 547 (defun-maybe texinfo-multitable-widths ()
 548   "Return list of widths of each column in a multi-column table."
 549   (let (texinfo-multitable-width-list)
 550     ;; Fractions format:
 551     ;;  @multitable @columnfractions .25 .3 .45
 552     ;;
 553     ;; Template format:
 554     ;;  @multitable {Column 1 template} {Column 2} {Column 3 example}
 555     ;; Place point before first argument
 556     (skip-chars-forward " \t")
 557     (cond
 558      ;; Check for common misspelling
 559      ((looking-at "@columnfraction ")
 560       (error "In @multitable, @columnfractions misspelled"))
 561      ;; Case 1: @columnfractions .25 .3 .45
 562      ((looking-at "@columnfractions")
 563       (forward-word 1)
 564       (while (not (eolp))
 565         (setq texinfo-multitable-width-list
 566               (cons
 567                (truncate
 568                 (1-
 569                  (* fill-column (read (get-buffer (current-buffer))))))
 570                texinfo-multitable-width-list))))
 571      ;;
 572      ;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
 573      ((looking-at "{")
 574       (let ((start-of-templates (point)))
 575         (while (not (eolp))
 576           (skip-chars-forward " \t")
 577           (let* ((start-of-template (1+ (point)))
 578                  (end-of-template
 579                  ;; forward-sexp works with braces in Texinfo mode
 580                   (progn (forward-sexp 1) (1- (point)))))
 581             (setq texinfo-multitable-width-list
 582                   (cons (- (progn (goto-char end-of-template) (current-column))
 583                            (progn (goto-char start-of-template) (current-column)))
 584                         texinfo-multitable-width-list))
 585             ;; Remove carriage return from within a template, if any.
 586             ;; This helps those those who want to use more than
 587             ;; one line's worth of words in @multitable line.
 588             (narrow-to-region start-of-template end-of-template)
 589             (goto-char (point-min))
 590             (while (search-forward "
 591 " nil t)
 592               (delete-char -1))
 593             (goto-char (point-max))
 594             (widen)
 595             (forward-char 1)))))
 596      ;;
 597      ;; Case 3: Trouble
 598      (t
 599       (error
 600        "You probably need to specify column widths for @multitable correctly")))
 601     ;; Check whether columns fit on page.
 602     (let ((desired-columns
 603            (+
 604             ;; between column spaces
 605             (length texinfo-multitable-width-list)
 606             ;; additional between column spaces, if any
 607             texinfo-extra-inter-column-width
 608             ;; sum of spaces for each entry
 609             (apply '+ texinfo-multitable-width-list))))
 610       (if (> desired-columns fill-column)
 611           (error
 612            (format
 613             "Multi-column table width, %d chars, is greater than page width, %d chars."
 614             desired-columns fill-column))))
 615     texinfo-multitable-width-list))
 616
 617 ;; @item  A1  @tab  A2  @tab  A3
 618 (defun-maybe texinfo-multitable-extract-row ()
 619   "Return multitable row, as a string.
 620 End of row is beginning of next @item or beginning of @end.
 621 Cells within rows are separated by @tab."
 622   (skip-chars-forward " \t")
 623   (let* ((start (point))
 624          (end (progn
 625                 (re-search-forward "@item\\|@end")
 626                 (match-beginning 0)))
 627          (row (progn (goto-char end)
 628                      (skip-chars-backward " ")
 629                      ;; remove whitespace at end of argument
 630                      (delete-region (point) end)
 631                      (buffer-substring start (point)))))
 632     (delete-region texinfo-command-start end)
 633     row))
 634
 635 (when-broken texinfo-multitable-item
 636   (fmakunbound 'texinfo-multitable-item))
 637
 638 (put 'multitable 'texinfo-item 'texinfo-multitable-item)
 639 (defun-maybe texinfo-multitable-item ()
 640   "Format a row within a multicolumn table.
 641 Cells in row are separated by @tab.
 642 Widths of cells are specified by the arguments in the @multitable line.
 643 All cells are made to be the same height.
 644 This command is executed when texinfmt sees @item inside @multitable."
 645   (let ((original-buffer (current-buffer))
 646         (table-widths (reverse (car (cdr (car texinfo-stack)))))
 647         (existing-fill-column fill-column)
 648         start
 649         end
 650         (table-column       0)
 651         (table-entry-height 0)
 652         ;; unformatted row looks like:  A1  @tab  A2  @tab  A3
 653         ;; extract-row command deletes the source line in the table.
 654         (unformated-row (texinfo-multitable-extract-row)))
 655     ;; Use a temporary buffer
 656     (set-buffer (get-buffer-create texinfo-multitable-buffer-name))
 657     (delete-region (point-min) (point-max))
 658     (insert unformated-row)
 659     (goto-char (point-min))
 660 ;; 1. Check for correct number of @tab in line.
 661     (let ((tab-number 1))                       ; one @tab between two columns
 662       (while (search-forward "@tab" nil t)
 663         (setq tab-number (1+ tab-number)))
 664       (if (/= tab-number (length table-widths))
 665           (error "Wrong number of @tab's in a @multitable row")))
 666     (goto-char (point-min))
 667 ;; 2. Format each cell, and copy to a rectangle
 668     ;; buffer looks like this:    A1  @tab  A2  @tab  A3
 669     ;; Cell #1: format up to @tab
 670     ;; Cell #2: format up to @tab
 671     ;; Cell #3: format up to eob
 672     (while (not (eobp))
 673       (setq start (point))
 674       (setq end (save-excursion
 675                   (if (search-forward "@tab" nil 'move)
 676                       ;; Delete the @tab command, including the @-sign
 677                       (delete-region
 678                        (point)
 679                        (progn (forward-word -1) (1- (point)))))
 680                   (point)))
 681       ;; Set fill-column *wider* than needed to produce inter-column space
 682       (setq fill-column (+ 1
 683                            texinfo-extra-inter-column-width
 684                            (nth table-column table-widths)))
 685       (narrow-to-region start end)
 686       ;; Remove whitespace before and after entry.
 687       (skip-chars-forward " ")
 688       (delete-region (point) (save-excursion (beginning-of-line) (point)))
 689       (goto-char (point-max))
 690       (skip-chars-backward " ")
 691       (delete-region (point) (save-excursion (end-of-line) (point)))
 692       ;; Temorarily set texinfo-stack to nil so texinfo-format-scan
 693       ;; does not see an unterminated @multitable.
 694       (let (texinfo-stack)                      ; nil
 695         (texinfo-format-scan))
 696       (let (fill-prefix)                        ; no fill prefix
 697         (fill-region (point-min) (point-max)))
 698       (setq table-entry-height
 699             (max table-entry-height (count-lines (point-min) (point-max))))
 700 ;; 3. Move point to end of bottom line, and pad that line to fill column.
 701       (goto-char (point-min))
 702       (forward-line (1- table-entry-height))
 703       (let* ((beg (point))                      ; beginning of line
 704              ;; add one more space for inter-column spacing
 705              (needed-whitespace
 706               (1+
 707                (- fill-column
 708                   (progn (end-of-line) (current-column)))))) ; end of existing line
 709         (insert (make-string
 710                  (if (> needed-whitespace 0) needed-whitespace 1)
 711                  ? )))
 712       ;; now, put formatted cell into a rectangle
 713       (set (intern (concat texinfo-multitable-rectangle-name
 714                            (int-to-string table-column)))
 715            (extract-rectangle (point-min) (point)))
 716       (delete-region (point-min) (point))
 717       (goto-char (point-max))
 718       (setq table-column (1+ table-column))
 719       (widen))
 720 ;; 4. Add extra lines to rectangles so all are of same height
 721     (let ((total-number-of-columns table-column)
 722           (column-number 0)
 723           here)
 724       (while (> table-column 0)
 725         (let ((this-rectangle (int-to-string table-column)))
 726           (while (< (length this-rectangle) table-entry-height)
 727             (setq this-rectangle (append this-rectangle '("")))))
 728         (setq table-column (1- table-column)))
 729 ;; 5. Insert formatted rectangles in original buffer
 730       (switch-to-buffer original-buffer)
 731       (open-line table-entry-height)
 732       (while (< column-number total-number-of-columns)
 733         (setq here (point))
 734         (insert-rectangle
 735          (eval (intern
 736                 (concat texinfo-multitable-rectangle-name
 737                         (int-to-string column-number)))))
 738         (goto-char here)
 739         (end-of-line)
 740         (setq column-number (1+ column-number))))
 741     (kill-buffer texinfo-multitable-buffer-name)
 742     (setq fill-column existing-fill-column)))
 743
 744 \f
 745 (when-broken texinfo-format-printindex
 746   (fmakunbound 'texinfo-format-printindex))
 747
 748 (defun-maybe texinfo-format-printindex ()
 749   (let ((indexelts (symbol-value
 750                     (cdr (assoc (texinfo-parse-arg-discard)
 751                                 texinfo-indexvar-alist))))
 752         opoint)
 753     (insert "\n* Menu:\n\n")
 754     (setq opoint (point))
 755     (texinfo-print-index nil indexelts)
 756
 757     (if (memq system-type '(vax-vms windows-nt ms-dos))
 758         (texinfo-sort-region opoint (point))
 759       (shell-command-on-region opoint (point) "sort -fd" 1))))
 760
 761 ;;; ptexinfmt.el ends here