1;;; ptexinfmt.el -- portable Texinfo formatter. -*- lexical-binding: t -*-
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;;	Katsumi Yamaoka <yamaoka@jpl.org>
11;; Maintainer: TAKAHASHI Kaoru <kaoru@kaisei.org>
12;; Created: 7 Jul 2000
13;; Keywords: maint, tex, docs, emulation, compatibility
14
15;; This program is free software; you can redistribute it and/or
16;; modify it under the terms of the GNU General Public License as
17;; published by the Free Software Foundation; either version 2, or (at
18;; your option) any later version.
19
20;; This program is distributed in the hope that it will be useful, but
21;; WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23;; General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs; see the file COPYING.  If not, write to the
27;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28;; Boston, MA 02110-1301, USA.
29
30;;; Commentary:
31
32;; Original code: Yoshiki Hayashi <yoshiki@xemacs.org>
33;;	makeinfo.el (gnujdoc project)
34
35;; Support texinfmt.el 2.32 or later.
36
37;; Modified by Yamaoka not to use APEL functions.
38
39;; Unimplemented command:
40;;  @abbr{ABBREVIATION}
41;;  @float ... @end float, @caption{TEXT}, @shortcaption{TEXT}, @listoffloats
42;;  @deftypecv[x]
43;;  @headitem
44;;  @comma{}
45;;  @quotation (optional arguments)
46;;  @acronym{ACRONYM[, MEANING]} (optional argument)
47;;  @dofirstparagraphindent
48;;  @indent
49;;  @verbatiminclude FILENAME
50;;  @\
51;;  @definfoenclose phoo,//,\\
52;;  @deftypeivar CLASS DATA-TYPE VARIABLE-NAME
53;;  @deftypeop CATEGORY CLASS DATA-TYPE NAME ARGUMENTS...
54;;  @allowcodebreaks false
55;;  @thischapternum
56;;  @quotedblleft @quotedblright
57;;  @quoteleft @quoteright  @quotedblbase @quotesinglbase
58;;  @guillemetleft @guillemetright @guilsinglleft @guilsinglright.
59;;  @clicksequence, @click, @clickstyle, @arrow
60
61;;; Code:
62
63(require 'texinfmt)
64
65;;; Broken
66(defvar ptexinfmt-disable-broken-notice-flag t
67  "If non-nil disable notice, when call `ptexinfmt-broken-facility'.
68This is last argument in `ptexinfmt-broken-facility'.")
69
70(put 'ptexinfmt-broken-facility 'lisp-indent-function 'defun)
71(defmacro ptexinfmt-broken-facility (facility docstring assertion
72					      &optional _dummy)
73  "Declare a symbol FACILITY is broken if ASSERTION is nil.
74DOCSTRING will be printed if ASSERTION is nil and
75`ptexinfmt-disable-broken-notice-flag' is nil."
76  `(let ((facility ',facility)
77	 (docstring ,docstring)
78	 (assertion (eval ',assertion)))
79     (put facility 'broken (not assertion))
80     (if assertion
81	 nil
82       (put facility 'broken-docstring docstring)
83       (if ptexinfmt-disable-broken-notice-flag
84	   nil
85	 (message "BROKEN FACILITY DETECTED: %s" docstring)))))
86
87(put 'ptexinfmt-defun-if-broken 'lisp-indent-function 'defun)
88(defmacro ptexinfmt-defun-if-broken (&rest args)
89  "Redefine a function just like `defun' if it is considered broken."
90  (let ((name (list 'quote (car args))))
91    (setq args (cdr args))
92    `(prog1
93	 ,name
94       (if (get ,name 'broken)
95	   (defalias ,name
96	     (function (lambda ,@args)))))))
97
98(put 'ptexinfmt-defun-if-void 'lisp-indent-function 'defun)
99(defmacro ptexinfmt-defun-if-void (&rest args)
100  "Define a function just like `defun' unless it is already defined."
101  (let ((name (list 'quote (car args))))
102    (setq args (cdr args))
103    `(prog1
104	 ,name
105       (if (fboundp ,name)
106	   nil
107	 (defalias ,name
108	   (function (lambda ,@args)))))))
109
110(put 'ptexinfmt-defvar-if-void 'lisp-indent-function 'defun)
111(defmacro ptexinfmt-defvar-if-void (&rest args)
112  "Define a variable just like `defvar' unless it is already defined."
113  (let ((name (car args)))
114    (setq args (cdr args))
115    `(prog1
116	 (defvar ,name)
117       (if (boundp ',name)
118	   nil
119	 (defvar ,name ,@args)))))
120
121;; sort -fd
122(ptexinfmt-broken-facility texinfo-format-printindex
123  "Can't sort on Mule for Windows."
124  (if (and (memq system-type '(windows-nt ms-dos))
125;;; I don't know version threshold.
126;;;	   (string< texinfmt-version "2.37 of 24 May 1997")
127	   (boundp 'MULE) (not (featurep 'meadow))) ; Mule for Windows
128      nil
129    t))
130
131;; @var{METASYNTACTIC-VARIABLE}
132(defvar texinfo-enclosure-list)
133(defvar texinfo-alias-list)
134(ptexinfmt-broken-facility texinfo-format-var
135  "Don't perse @var argument."
136  (condition-case nil
137      (with-temp-buffer
138	(let (texinfo-enclosure-list texinfo-alias-list)
139	  (texinfo-mode)
140	  (insert "@var{@asis{foo}}\n")
141	  (texinfo-format-expand-region (point-min) (point-max))
142	  t))
143    (error nil)))
144
145;; @xref{NODE-NAME[, CROSS-REFERENCE-NAME, TITLE-OR-TOPIC,
146;;     INFO-FILE-NAME, PRINTED-MANUAL-TITLE]}.
147(ptexinfmt-broken-facility texinfo-format-xref
148  "Can't format @xref, 1st argument is empty."
149  (condition-case nil
150      (with-temp-buffer
151	(let (texinfo-enclosure-list texinfo-alias-list)
152	  (texinfo-mode)
153	  (insert "@xref{, xref, , file}\n")
154	  (texinfo-format-expand-region (point-min) (point-max))
155	  t))
156    (error nil)))
157
158;; @uref{URL[, TEXT][, REPLACEMENT]}
159(ptexinfmt-broken-facility texinfo-format-uref
160  "Parse twice @uref argument."
161  (condition-case nil
162      (with-temp-buffer
163	(let (texinfo-enclosure-list texinfo-alias-list)
164	  (texinfo-mode)
165	  (insert "@uref{mailto:foo@@noncommand.example.com}\n")
166	  (texinfo-format-expand-region (point-min) (point-max))
167	  t))
168    (error nil)))
169
170;; @multitable
171(ptexinfmt-broken-facility texinfo-multitable-widths
172  "`texinfo-multitable-widths' unsupport wide-char."
173  (if (fboundp 'texinfo-multitable-widths)
174      (with-temp-buffer
175	(let ((str (string (make-char 'japanese-jisx0208 73 125)
176			   (make-char 'japanese-jisx0208 57 45)
177			   (make-char 'japanese-jisx0208 74 56)
178			   (make-char 'japanese-jisx0208 59 122))))
179	  (texinfo-mode)
180	  (insert (format " {%s}\n" str))
181	  (goto-char (point-min))
182	  (if (= (car (texinfo-multitable-widths)) (length str))
183	      t
184	    nil)))
185    ;; function definition is void
186    nil))
187
188(ptexinfmt-broken-facility texinfo-multitable-item
189  "`texinfo-multitable-item' unsupport wide-char."
190  (not (get 'texinfo-multitable-widths 'broken)))
191
192
193;;; Hardcopy and HTML (discard)
194;; html
195(put 'documentlanguage 'texinfo-format 'texinfo-discard-line-with-args)
196(put 'documentencoding 'texinfo-format 'texinfo-discard-line-with-args)
197(put 'documentdescription 'texinfo-format 'texinfo-discard-line-with-args)
198
199;; size
200(put 'smallbook 'texinfo-format 'texinfo-discard-line)
201(put 'letterpaper 'texinfo-format 'texinfo-discard-line)
202(put 'afourpaper 'texinfo-format 'texinfo-discard-line)
203(put 'afourlatex 'texinfo-format 'texinfo-discard-line)
204(put 'afourwide 'texinfo-format 'texinfo-discard-line)
205(put 'afivepaper 'texinfo-format 'texinfo-discard-line)
206(put 'pagesizes 'texinfo-format 'texinfo-discard-line-with-args)
207(put 'fonttextsize 'texinfo-format 'texinfo-discard-line-with-args)
208
209;; style
210(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
211(put 'kbdinputstyle 'texinfo-format 'texinfo-discard-line-with-args)
212
213;; flags
214(put 'setcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
215(put 'setshortcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
216(put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args)
217(put 'frenchspacing 'texinfo-format 'texinfo-discard-line-with-args)
218
219;; head & foot
220(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
221(put 'evenfooting 'texinfo-format 'texinfo-discard-line-with-args)
222(put 'evenheading 'texinfo-format 'texinfo-discard-line-with-args)
223(put 'oddfooting 'texinfo-format 'texinfo-discard-line-with-args)
224(put 'oddheading 'texinfo-format 'texinfo-discard-line-with-args)
225(put 'everyfooting 'texinfo-format 'texinfo-discard-line-with-args)
226(put 'everyheading 'texinfo-format 'texinfo-discard-line-with-args)
227
228;; misc
229(put 'page 'texinfo-format 'texinfo-discard-line)
230(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
231
232;; @slanted{TEXT} (makeinfo 4.8 or later)
233(put 'slanted 'texinfo-format 'texinfo-format-noop)
234
235;; @sansserif{TEXT} (makeinfo 4.8 or later)
236(put 'sansserif 'texinfo-format 'texinfo-format-noop)
237
238;; @tie{} (makeinfo 4.3 or later)
239(put 'tie 'texinfo-format 'texinfo-format-tie)
240(ptexinfmt-defun-if-void texinfo-format-tie ()
241  (texinfo-parse-arg-discard)
242  (insert " "))
243
244
245;;; Directory File
246;; @direcategory DIRPART
247(put 'dircategory 'texinfo-format 'texinfo-format-dircategory)
248(ptexinfmt-defun-if-void texinfo-format-dircategory ()
249  (let ((str (texinfo-parse-arg-discard)))
250    (delete-region (point)
251		   (progn
252		     (skip-chars-forward " ")
253		     (point)))
254    (insert "INFO-DIR-SECTION " str "\n")))
255
256;; @direntry ... @end direntry
257(put 'direntry 'texinfo-format 'texinfo-format-direntry)
258(ptexinfmt-defun-if-void texinfo-format-direntry ()
259  (texinfo-push-stack 'direntry nil)
260  (texinfo-discard-line)
261  (insert "START-INFO-DIR-ENTRY\n"))
262
263(put 'direntry 'texinfo-end 'texinfo-end-direntry)
264(ptexinfmt-defun-if-void texinfo-end-direntry ()
265  (texinfo-discard-command)
266  (insert "END-INFO-DIR-ENTRY\n\n")
267  (texinfo-pop-stack 'direntry))
268
269
270;;; Block Enclosing
271;; @detailmenu ... @end detailmenu
272(put 'detailmenu 'texinfo-format 'texinfo-discard-line)
273(put 'detailmenu 'texinfo-end 'texinfo-discard-command)
274
275;; @smalldisplay ... @end smalldisplay
276(put 'smalldisplay 'texinfo-format 'texinfo-format-example)
277(put 'smalldisplay 'texinfo-end 'texinfo-end-example)
278
279;; @smallformat ... @end smallformat
280(put 'smallformat 'texinfo-format 'texinfo-format-flushleft)
281(put 'smallformat 'texinfo-end 'texinfo-end-flushleft)
282
283;; @cartouche  ... @end cartouche
284(put 'cartouche 'texinfo-format 'texinfo-discard-line)
285(put 'cartouche 'texinfo-end 'texinfo-discard-command)
286
287
288;;; Conditional
289;; @ifnottex ... @end ifnottex (makeinfo 3.11 or later)
290(put 'ifnottex 'texinfo-format 'texinfo-discard-line)
291(put 'ifnottex 'texinfo-end 'texinfo-discard-command)
292
293;; @ifnothtml ... @end ifnothtml (makeinfo 3.11 or later)
294(put 'ifnothtml 'texinfo-format 'texinfo-discard-line)
295(put 'ifnothtml 'texinfo-end 'texinfo-discard-command)
296
297;; @ifnotplaintext ... @end ifnotplaintext (makeinfo 4.2 or later)
298(put 'ifnotplaintext 'texinfo-format 'texinfo-discard-line)
299(put 'ifnotplaintext 'texinfo-end 'texinfo-discard-command)
300
301;; @ifnotdocbook ... @end ifnotdocbook (makeinfo 4.7 or later)
302(put 'ifnotdocbook 'texinfo-format 'texinfo-discard-line)
303(put 'ifnotdocbook 'texinfo-end 'texinfo-discard-command)
304
305;; @ifnotinfo ... @end ifnotinfo (makeinfo 3.11 or later)
306(put 'ifnotinfo 'texinfo-format 'texinfo-format-ifnotinfo)
307(ptexinfmt-defun-if-void texinfo-format-ifnotinfo ()
308  (delete-region texinfo-command-start
309		 (progn (re-search-forward "@end ifnotinfo[ \t]*\n")
310			(point))))
311
312;; @html ... @end html (makeinfo 3.11 or later)
313(put 'html 'texinfo-format 'texinfo-format-html)
314(ptexinfmt-defun-if-void texinfo-format-html ()
315  (delete-region texinfo-command-start
316		 (progn (re-search-forward "@end html[ \t]*\n")
317			(point))))
318
319;; @docbook ... @end docbook (makeinfo 4.7 or later)
320(put 'docbook 'texinfo-format 'texinfo-format-docbook)
321(ptexinfmt-defun-if-void texinfo-format-docbook ()
322  (delete-region texinfo-command-start
323		 (progn (re-search-forward "@end docbook[ \t]*\n")
324			(point))))
325
326;; @ifhtml ... @end ifhtml (makeinfo 3.8 or later)
327(put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml)
328(defun texinfo-format-ifhtml ()
329  (delete-region texinfo-command-start
330		 (progn (re-search-forward "@end ifhtml[ \t]*\n")
331			(point))))
332
333;; @ifplaintext ... @end ifplaintext (makeinfo 4.2 or later)
334(put 'ifplaintext 'texinfo-format 'texinfo-format-ifplaintext)
335(ptexinfmt-defun-if-void texinfo-format-ifplaintext ()
336  (delete-region texinfo-command-start
337		 (progn (re-search-forward "@end ifplaintext[ \t]*\n")
338			(point))))
339
340;; @ifdocbook ... @end ifdocbook (makeinfo 4.7 or later)
341(put 'ifdocbook 'texinfo-format 'texinfo-format-ifdocbook)
342(ptexinfmt-defun-if-void texinfo-format-ifdocbook ()
343  (delete-region texinfo-command-start
344		 (progn (re-search-forward "@end ifdocbook[ \t]*\n")
345			(point))))
346
347
348;;; Marking
349;; @env{ENVIRONMENT-VARIABLE}
350(put 'env 'texinfo-format 'texinfo-format-code)
351
352;; @command{COMMAND-NAME}
353(put 'command 'texinfo-format 'texinfo-format-code)
354
355;; @indicateurl{INDICATEURL}
356(put 'indicateurl 'texinfo-format 'texinfo-format-code)
357
358;; @url{URL[, DISPLAYED-TEXT][, REPLACEMENT}
359(put 'url 'texinfo-format 'texinfo-format-uref)	; Texinfo 4.7
360
361;; @acronym{ACRONYM}
362(put 'acronym 'texinfo-format 'texinfo-format-var)
363
364;; @var{METASYNTACTIC-VARIABLE}
365(ptexinfmt-defun-if-broken texinfo-format-var ()
366  (let ((arg (texinfo-parse-expanded-arg)))
367    (texinfo-discard-command)
368    (insert (upcase arg))))
369
370;; @key{KEY-NAME}
371(put 'key 'texinfo-format 'texinfo-format-key)
372(ptexinfmt-defun-if-void texinfo-format-key ()
373  (insert (texinfo-parse-arg-discard))
374  (goto-char texinfo-command-start))
375
376;; @email{EMAIL-ADDRESS[, DISPLAYED-TEXT]}
377(put 'email 'texinfo-format 'texinfo-format-email)
378(ptexinfmt-defun-if-void texinfo-format-email ()
379  "Format EMAIL-ADDRESS and optional DISPLAYED-TXT.
380Insert < ... > around EMAIL-ADDRESS."
381  (let ((args (texinfo-format-parse-args)))
382  (texinfo-discard-command)
383    ;; if displayed-text
384    (if (nth 1 args)
385	(insert (nth 1 args) " <" (nth 0 args) ">")
386      (insert "<" (nth 0 args) ">"))))
387
388;; @option{OPTION-NAME}
389(put 'option 'texinfo-format 'texinfo-format-option)
390(ptexinfmt-defun-if-void texinfo-format-option ()
391  "Insert ` ... ' around arg unless inside a table; in that case, no quotes."
392  ;; `looking-at-backward' not available in v. 18.57, 20.2
393  ;; searched-for character is a control-H
394  (if (not (search-backward "\010"
395			    (save-excursion (beginning-of-line) (point))
396			    t))
397      (insert "`" (texinfo-parse-arg-discard) "'")
398    (insert (texinfo-parse-arg-discard)))
399  (goto-char texinfo-command-start))
400
401;; @verb{<char>TEXT<char>}  (makeinfo 4.1 or later)
402(put 'verb 'texinfo-format 'texinfo-format-verb)
403(ptexinfmt-defun-if-void texinfo-format-verb ()
404  "Format text between non-quoted unique delimiter characters verbatim.
405Enclose the verbatim text, including the delimiters, in braces.  Print
406text exactly as written (but not the delimiters) in a fixed-width.
407
408For example, @verb\{|@|\} results in @ and
409@verb\{+@'e?`!`+} results in @'e?`!`."
410
411  (let ((delimiter (buffer-substring-no-properties
412		    (1+ texinfo-command-end) (+ 2 texinfo-command-end))))
413    (unless (looking-at "{")
414      (error "Not found: @verb start brace"))
415    (delete-region texinfo-command-start (+ 2 texinfo-command-end))
416    (search-forward  delimiter))
417  (delete-char -1)
418  (unless (looking-at "}")
419    (error "Not found: @verb end brace"))
420  (delete-char 1))
421
422
423;; @LaTeX{}
424(put 'LaTeX 'texinfo-format 'texinfo-format-LaTeX)
425(ptexinfmt-defun-if-void texinfo-format-LaTeX ()
426  (texinfo-parse-arg-discard)
427  (insert "LaTeX"))
428
429;; @registeredsymbol{}
430(put 'registeredsymbol 'texinfo-format 'texinfo-format-registeredsymbol)
431(ptexinfmt-defun-if-void texinfo-format-registeredsymbol ()
432  (texinfo-parse-arg-discard)
433  (insert "(R)"))
434
435;;; Accents and Special characters
436;; @euro{}	==>	Euro
437(put 'euro 'texinfo-format 'texinfo-format-euro)
438(ptexinfmt-defun-if-void texinfo-format-euro ()
439  (texinfo-parse-arg-discard)
440  (insert "Euro "))
441
442;; @pounds{}	==>	#	Pounds Sterling
443(put 'pounds 'texinfo-format 'texinfo-format-pounds)
444(ptexinfmt-defun-if-void texinfo-format-pounds ()
445  (texinfo-parse-arg-discard)
446  (insert "#"))
447
448;; @ordf{}	==>	a	Spanish feminine
449(put 'ordf 'texinfo-format 'texinfo-format-ordf)
450(ptexinfmt-defun-if-void texinfo-format-ordf ()
451  (texinfo-parse-arg-discard)
452  (insert "a"))
453
454;; @ordm{}	==>	o	Spanish masculine
455(put 'ordm 'texinfo-format 'texinfo-format-ordm)
456(ptexinfmt-defun-if-void texinfo-format-ordm ()
457  (texinfo-parse-arg-discard)
458  (insert "o"))
459
460;; @OE{}	==>	OE	French-OE-ligature
461(put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature)
462(ptexinfmt-defun-if-void texinfo-format-French-OE-ligature ()
463  (insert "OE" (texinfo-parse-arg-discard))
464  (goto-char texinfo-command-start))
465
466;; @oe{}	==>	oe
467(put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature)
468(ptexinfmt-defun-if-void texinfo-format-French-oe-ligature () ; lower case
469  (insert "oe" (texinfo-parse-arg-discard))
470  (goto-char texinfo-command-start))
471
472;; @AA{}	==>	AA	Scandinavian-A-with-circle
473(put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle)
474(ptexinfmt-defun-if-void texinfo-format-Scandinavian-A-with-circle ()
475  (insert "AA" (texinfo-parse-arg-discard))
476  (goto-char texinfo-command-start))
477
478;; @aa{}	==>	aa
479(put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle)
480(ptexinfmt-defun-if-void texinfo-format-Scandinavian-a-with-circle () ; lower case
481  (insert "aa" (texinfo-parse-arg-discard))
482  (goto-char texinfo-command-start))
483
484;; @AE{}	==>	AE	Latin-Scandinavian-AE
485(put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE)
486(ptexinfmt-defun-if-void texinfo-format-Latin-Scandinavian-AE ()
487  (insert "AE" (texinfo-parse-arg-discard))
488  (goto-char texinfo-command-start))
489
490;; @ae{}	==>	ae
491(put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae)
492(ptexinfmt-defun-if-void texinfo-format-Latin-Scandinavian-ae () ; lower case
493  (insert "ae" (texinfo-parse-arg-discard))
494  (goto-char texinfo-command-start))
495
496;; @ss{}	==>	ss	German-sharp-S
497(put 'ss 'texinfo-format 'texinfo-format-German-sharp-S)
498(ptexinfmt-defun-if-void texinfo-format-German-sharp-S ()
499  (insert "ss" (texinfo-parse-arg-discard))
500  (goto-char texinfo-command-start))
501
502;; @questiondown{}	==>	?	upside-down-question-mark
503(put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark)
504(ptexinfmt-defun-if-void texinfo-format-upside-down-question-mark ()
505  (insert "?" (texinfo-parse-arg-discard))
506  (goto-char texinfo-command-start))
507
508;; @exclamdown{}	==>	!	upside-down-exclamation-mark
509(put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark)
510(ptexinfmt-defun-if-void texinfo-format-upside-down-exclamation-mark ()
511  (insert "!" (texinfo-parse-arg-discard))
512  (goto-char texinfo-command-start))
513
514;; @L{}		==>	L/	Polish suppressed-L (Lslash)
515(put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L)
516(ptexinfmt-defun-if-void texinfo-format-Polish-suppressed-L ()
517  (insert (texinfo-parse-arg-discard) "/L")
518  (goto-char texinfo-command-start))
519
520;; @l{}		==>	l/	Polish suppressed-L (Lslash) (lower case)
521(put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case)
522(ptexinfmt-defun-if-void texinfo-format-Polish-suppressed-l-lower-case ()
523  (insert (texinfo-parse-arg-discard) "/l")
524  (goto-char texinfo-command-start))
525
526;; @O{}		==>	O/	Scandinavian O-with-slash
527(put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash)
528(ptexinfmt-defun-if-void texinfo-format-Scandinavian-O-with-slash ()
529  (insert (texinfo-parse-arg-discard) "O/")
530  (goto-char texinfo-command-start))
531
532;; @o{}		==>	o/	Scandinavian O-with-slash (lower case)
533(put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case)
534(ptexinfmt-defun-if-void texinfo-format-Scandinavian-o-with-slash-lower-case ()
535  (insert (texinfo-parse-arg-discard) "o/")
536  (goto-char texinfo-command-start))
537
538;; @,{c}	==>	c,	cedilla accent
539(put '\, 'texinfo-format 'texinfo-format-cedilla-accent)
540(ptexinfmt-defun-if-void texinfo-format-cedilla-accent ()
541  (insert (texinfo-parse-arg-discard) ",")
542  (goto-char texinfo-command-start))
543
544
545;; @dotaccent{o}	==>	.o	overdot-accent
546(put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent)
547(ptexinfmt-defun-if-void texinfo-format-overdot-accent ()
548  (insert "." (texinfo-parse-arg-discard))
549  (goto-char texinfo-command-start))
550
551;; @ubaraccent{o}	==>	_o	underbar-accent
552(put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent)
553(ptexinfmt-defun-if-void texinfo-format-underbar-accent ()
554  (insert "_" (texinfo-parse-arg-discard))
555  (goto-char texinfo-command-start))
556
557;; @udotaccent{o}	==>	o-.	underdot-accent
558(put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent)
559(ptexinfmt-defun-if-void texinfo-format-underdot-accent ()
560  (insert (texinfo-parse-arg-discard) "-.")
561  (goto-char texinfo-command-start))
562
563;; @H{o}	==>	""o	long Hungarian umlaut
564(put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut)
565(ptexinfmt-defun-if-void texinfo-format-long-Hungarian-umlaut ()
566  (insert "\"\"" (texinfo-parse-arg-discard))
567  (goto-char texinfo-command-start))
568
569;; @ringaccent{o}	==>	*o	ring accent
570(put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent)
571(ptexinfmt-defun-if-void texinfo-format-ring-accent ()
572  (insert "*" (texinfo-parse-arg-discard))
573  (goto-char texinfo-command-start))
574
575;; @tieaccent{oo}	==>	[oo	tie after accent
576(put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent)
577(ptexinfmt-defun-if-void texinfo-format-tie-after-accent ()
578  (insert "[" (texinfo-parse-arg-discard))
579  (goto-char texinfo-command-start))
580
581;; @u{o}	==>	(o	breve accent
582(put 'u 'texinfo-format 'texinfo-format-breve-accent)
583(ptexinfmt-defun-if-void texinfo-format-breve-accent ()
584  (insert "(" (texinfo-parse-arg-discard))
585  (goto-char texinfo-command-start))
586
587;; @v{o}	==>	<o	hacek accent
588(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
589(ptexinfmt-defun-if-void texinfo-format-hacek-accent ()
590  (insert "<" (texinfo-parse-arg-discard))
591  (goto-char texinfo-command-start))
592
593;; @dotless{i}	==>	i	dotless i and dotless j
594(put 'dotless 'texinfo-format 'texinfo-format-dotless)
595(ptexinfmt-defun-if-void texinfo-format-dotless ()
596  (insert (texinfo-parse-arg-discard))
597  (goto-char texinfo-command-start))
598
599;; @.
600(put '\. 'texinfo-format 'texinfo-format-\.)
601(ptexinfmt-defun-if-void texinfo-format-\. ()
602  (texinfo-discard-command)
603  (insert "."))
604
605;; @:
606(put '\: 'texinfo-format 'texinfo-format-\:)
607(ptexinfmt-defun-if-void texinfo-format-\: ()
608  (texinfo-discard-command))
609
610;; @-
611(put '\- 'texinfo-format 'texinfo-format-soft-hyphen)
612(ptexinfmt-defun-if-void texinfo-format-soft-hyphen ()
613  (texinfo-discard-command))
614
615;; @/
616(put '\/ 'texinfo-format 'texinfo-format-\/)
617(ptexinfmt-defun-if-void texinfo-format-\/ ()
618  (texinfo-discard-command))
619
620;; @textdegree{}
621(put 'textdegree 'texinfo-format 'texinfo-format-textdegree)
622(ptexinfmt-defun-if-void texinfo-format-textdegree ()
623  (insert "o" (texinfo-parse-arg-discard))
624  (goto-char texinfo-command-start))
625
626;; @geq{}
627(put 'geq 'texinfo-format 'texinfo-format-geq)
628(ptexinfmt-defun-if-void texinfo-format-geq ()
629  (insert ">=" (texinfo-parse-arg-discard))
630  (goto-char texinfo-command-start))
631
632;; @leq{}
633(put 'leq 'texinfo-format 'texinfo-format-leq)
634(ptexinfmt-defun-if-void texinfo-format-leq ()
635  (insert "<=" (texinfo-parse-arg-discard))
636  (goto-char texinfo-command-start))
637
638
639;;; Cross References
640;; @ref{NODE-NAME, ...}
641;; @xref{NODE-NAME, ...}
642(put 'ref 'texinfo-format 'texinfo-format-xref)
643
644(ptexinfmt-defun-if-broken texinfo-format-xref ()
645  (let ((args (texinfo-format-parse-args)))
646    (texinfo-discard-command)
647    (insert "*Note ")
648    (let ((fname (or (nth 1 args) (nth 2 args))))
649      (if (null (or fname (nth 3 args)))
650	  (insert (nth 0 args) "::")
651	(insert (or fname (nth 0 args)) ": ")
652	(if (nth 3 args)
653	    (insert "(" (nth 3 args) ")"))
654	(unless (null (nth 0 args))
655	  (insert (nth 0 args)))))))
656
657;; @uref{URL [,TEXT] [,REPLACEMENT]}
658(put 'uref 'texinfo-format 'texinfo-format-uref)
659(ptexinfmt-defun-if-broken texinfo-format-uref ()
660  "Format URL and optional URL-TITLE.
661Insert ` ... ' around URL if no URL-TITLE argument;
662otherwise, insert URL-TITLE followed by URL in parentheses."
663  (let ((args (texinfo-format-parse-args)))
664    (texinfo-discard-command)
665    ;; if url-title
666    (if (nth 1 args)
667	(insert  (nth 1 args) " (" (nth 0 args) ")")
668      (insert "`" (nth 0 args) "'"))))
669
670;; @inforef{NODE-NAME, CROSS-REFERENCE-NAME, INFO-FILE-NAME}
671(put 'inforef 'texinfo-format 'texinfo-format-inforef)
672(ptexinfmt-defun-if-void texinfo-format-inforef ()
673  (let ((args (texinfo-format-parse-args)))
674    (texinfo-discard-command)
675    (if (nth 1 args)
676	(insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args))
677      (insert "*Note " "(" (nth 2 args) ")" (car args) "::"))))
678
679
680;; @anchor{NAME}
681;; don't emulation
682;; If support @anchor for Mule 2.3, We must fix informat.el and info.el:
683;;  - Info-tagify suport @anthor-*-refill.
684;;  - info.el support Ref in Tag table.
685(unless (get 'anchor 'texinfo-format)
686  (put 'anchor 'texinfo-format 'texinfo-discard-command-and-arg))
687
688
689
690;;; New command definition
691;; @alias NEW=EXISTING
692(put 'alias 'texinfo-format 'texinfo-alias)
693(ptexinfmt-defun-if-void texinfo-alias ()
694  (let ((start (1- (point)))
695	args)
696    (skip-chars-forward " ")
697    (save-excursion (end-of-line) (setq texinfo-command-end (point)))
698    (if (not (looking-at "\\([^=]+\\)=\\(.*\\)"))
699	(error "Invalid alias command")
700      (setq texinfo-alias-list
701	    (cons
702	     (cons
703	      (buffer-substring (match-beginning 1) (match-end 1))
704	      (buffer-substring (match-beginning 2) (match-end 2)))
705	     texinfo-alias-list))
706      (texinfo-discard-command))))
707
708
709;;; Indent
710;; @exampleindent INDENT  (makeinfo 4.0 or later)
711
712;; @paragraphindent INDENT  (makeinfo 4.0 or later)
713;; INDENT: asis, 0, n
714
715;; @firstparagraphindent WORD   (makeinfo 4.6 or later)
716;; WORD: none, insert
717
718
719
720;;; Special
721;; @image{FILENAME [, WIDTH] [, HEIGHT]}
722(put 'image 'texinfo-format 'texinfo-format-image)
723(ptexinfmt-defun-if-void texinfo-format-image ()
724  ;; I don't know makeinfo parse FILENAME.
725  (let ((args (texinfo-format-parse-args))
726	filename)
727    (when (null (nth 0 args))
728      (error "Invalid image command"))
729    (texinfo-discard-command)
730    ;; makeinfo uses FILENAME.txt
731    (setq filename (format "%s.txt" (nth 0 args)))
732    (message "Reading included file: %s" filename)
733    ;; verbatim for Info output
734    (goto-char (+ (point) (cadr (insert-file-contents filename))))
735    (message "Reading included file: %s...done" filename)))
736
737
738
739;;; @multitable ... @end multitable
740(ptexinfmt-defvar-if-void texinfo-extra-inter-column-width 0
741  "*Number of extra spaces between entries (columns) in @multitable.")
742
743(ptexinfmt-defvar-if-void texinfo-multitable-buffer-name
744  "*multitable-temporary-buffer*")
745(ptexinfmt-defvar-if-void texinfo-multitable-rectangle-name
746  "texinfo-multitable-temp-")
747
748;; These commands are defined in texinfo.tex for printed output.
749(put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args)
750(put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args)
751(put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args)
752(put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args)
753
754(put 'multitable 'texinfo-format 'texinfo-multitable)
755
756(ptexinfmt-defun-if-void texinfo-multitable ()
757  "Produce multi-column tables."
758
759;; This function pushes information onto the `texinfo-stack'.
760;; A stack element consists of:
761;;   - type-of-command, i.e., multitable
762;;   - the information about column widths, and
763;;   - the position of texinfo-command-start.
764;; e.g., ('multitable (1 2 3 4) 123)
765;; The command line is then deleted.
766  (texinfo-push-stack
767   'multitable
768   ;; push width information on stack
769   (texinfo-multitable-widths))
770  (texinfo-discard-line-with-args))
771
772(put 'multitable 'texinfo-end 'texinfo-end-multitable)
773(ptexinfmt-defun-if-void texinfo-end-multitable ()
774  "Discard the @end multitable line and pop the stack of multitable."
775  (texinfo-discard-command)
776  (texinfo-pop-stack 'multitable))
777
778(ptexinfmt-defun-if-broken texinfo-multitable-widths ()
779  "Return list of widths of each column in a multi-column table."
780  (let (texinfo-multitable-width-list)
781    ;; Fractions format:
782    ;;  @multitable @columnfractions .25 .3 .45
783    ;;
784    ;; Template format:
785    ;;  @multitable {Column 1 template} {Column 2} {Column 3 example}
786    ;; Place point before first argument
787    (skip-chars-forward " \t")
788    (cond
789     ;; Check for common misspelling
790     ((looking-at "@columnfraction ")
791      (error "In @multitable, @columnfractions misspelled"))
792     ;; Case 1: @columnfractions .25 .3 .45
793     ((looking-at "@columnfractions")
794      (forward-word 1)
795      (while (not (eolp))
796	(setq texinfo-multitable-width-list
797	      (cons
798	       (truncate
799		(1-
800		 (* fill-column (read (get-buffer (current-buffer))))))
801	       texinfo-multitable-width-list))))
802     ;;
803     ;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
804     ((looking-at "{")
805      (let ((start-of-templates (point)))
806	(while (not (eolp))
807	  (skip-chars-forward " \t")
808	  (let* ((start-of-template (1+ (point)))
809		 (end-of-template
810		  ;; forward-sexp works with braces in Texinfo mode
811		  (progn (forward-sexp 1) (1- (point)))))
812	    (setq texinfo-multitable-width-list
813		  (cons (- (progn
814			     (goto-char end-of-template)
815			     (current-column))
816			   (progn
817			     (goto-char start-of-template)
818			     (current-column)))
819			texinfo-multitable-width-list))
820	    ;; Remove carriage return from within a template, if any.
821	    ;; This helps those those who want to use more than
822	    ;; one line's worth of words in @multitable line.
823	    (narrow-to-region start-of-template end-of-template)
824	    (goto-char (point-min))
825	    (while (search-forward "\n" nil t)
826	      (delete-char -1))
827	    (goto-char (point-max))
828	    (widen)
829	    (forward-char 1)))))
830     ;;
831     ;; Case 3: Trouble
832     (t
833      (error "\
834You probably need to specify column widths for @multitable correctly")))
835    ;; Check whether columns fit on page.
836    (let ((desired-columns
837	   (+
838	    ;; between column spaces
839	    (length texinfo-multitable-width-list)
840	    ;; additional between column spaces, if any
841	    texinfo-extra-inter-column-width
842	    ;; sum of spaces for each entry
843	    (apply '+ texinfo-multitable-width-list))))
844      (if (> desired-columns fill-column)
845	  (error (format "\
846Multi-column table width, %d chars, is greater than page width, %d chars."
847			 desired-columns fill-column))))
848    texinfo-multitable-width-list))
849
850;; @item  A1  @tab  A2  @tab  A3
851(ptexinfmt-defun-if-void texinfo-multitable-extract-row ()
852  "Return multitable row, as a string.
853End of row is beginning of next @item or beginning of @end.
854Cells within rows are separated by @tab."
855  (skip-chars-forward " \t")
856  (let* ((start (point))
857	 (end (progn
858		(re-search-forward "@item\\|@end")
859		(match-beginning 0)))
860	 (row (progn (goto-char end)
861		     (skip-chars-backward " ")
862		     ;; remove whitespace at end of argument
863		     (delete-region (point) end)
864		     (buffer-substring start (point)))))
865    (delete-region texinfo-command-start end)
866    row))
867
868(put 'multitable 'texinfo-item 'texinfo-multitable-item)
869(ptexinfmt-defun-if-void texinfo-multitable-item ()
870  "Format a row within a multicolumn table.
871Cells in row are separated by @tab.
872Widths of cells are specified by the arguments in the @multitable line.
873All cells are made to be the same height.
874This command is executed when texinfmt sees @item inside @multitable."
875  (let ((original-buffer (current-buffer))
876	(table-widths (reverse (car (cdr (car texinfo-stack)))))
877	(existing-fill-column fill-column)
878	start
879	end
880	(table-column       0)
881	(table-entry-height 0)
882	;; unformatted row looks like:  A1  @tab  A2  @tab  A3
883	;; extract-row command deletes the source line in the table.
884	(unformated-row (texinfo-multitable-extract-row)))
885    ;; Use a temporary buffer
886    (set-buffer (get-buffer-create texinfo-multitable-buffer-name))
887    (delete-region (point-min) (point-max))
888    (insert unformated-row)
889    (goto-char (point-min))
890;; 1. Check for correct number of @tab in line.
891    (let ((tab-number 1)) ;; one @tab between two columns
892      (while (search-forward "@tab" nil t)
893	(setq tab-number (1+ tab-number)))
894      (if (/= tab-number (length table-widths))
895	  (error "Wrong number of @tab's in a @multitable row")))
896    (goto-char (point-min))
897;; 2. Format each cell, and copy to a rectangle
898    ;; buffer looks like this:    A1  @tab  A2  @tab  A3
899    ;; Cell #1: format up to @tab
900    ;; Cell #2: format up to @tab
901    ;; Cell #3: format up to eob
902    (while (not (eobp))
903      (setq start (point))
904      (setq end (save-excursion
905		  (if (search-forward "@tab" nil 'move)
906		      ;; Delete the @tab command, including the @-sign
907		      (delete-region
908		       (point)
909		       (progn (forward-word -1) (1- (point)))))
910		  (point)))
911      ;; Set fill-column *wider* than needed to produce inter-column space
912      (setq fill-column (+ 1
913			   texinfo-extra-inter-column-width
914			   (nth table-column table-widths)))
915      (narrow-to-region start end)
916      ;; Remove whitespace before and after entry.
917      (skip-chars-forward " ")
918      (delete-region (point) (save-excursion (beginning-of-line) (point)))
919      (goto-char (point-max))
920      (skip-chars-backward " ")
921      (delete-region (point) (save-excursion (end-of-line) (point)))
922      ;; Temorarily set texinfo-stack to nil so texinfo-format-scan
923      ;; does not see an unterminated @multitable.
924      (let (texinfo-stack) ;; nil
925	(texinfo-format-scan))
926      (let (fill-prefix) ;; no fill prefix
927	(fill-region (point-min) (point-max)))
928      (setq table-entry-height
929	    (max table-entry-height (count-lines (point-min) (point-max))))
930;; 3. Move point to end of bottom line, and pad that line to fill column.
931      (goto-char (point-min))
932      (forward-line (1- table-entry-height))
933      (let* ((beg (point)) ;; beginning of line
934	     ;; add one more space for inter-column spacing
935	     (needed-whitespace
936	      (1+
937	       (- fill-column
938		  (progn
939		    (end-of-line)
940		    (current-column)))))) ;; end of existing line
941	(insert (make-string
942		 (if (> needed-whitespace 0) needed-whitespace 1)
943		 ? )))
944      ;; now, put formatted cell into a rectangle
945      (set (intern (concat texinfo-multitable-rectangle-name
946			   (int-to-string table-column)))
947	   (extract-rectangle (point-min) (point)))
948      (delete-region (point-min) (point))
949      (goto-char (point-max))
950      (setq table-column (1+ table-column))
951      (widen))
952;; 4. Add extra lines to rectangles so all are of same height
953    (let ((total-number-of-columns table-column)
954	  (column-number 0)
955	  here)
956      (while (> table-column 0)
957	(let ((this-rectangle (int-to-string table-column)))
958	  (while (< (length this-rectangle) table-entry-height)
959	    (setq this-rectangle (append this-rectangle '("")))))
960	(setq table-column (1- table-column)))
961;; 5. Insert formatted rectangles in original buffer
962      (switch-to-buffer original-buffer)
963      (open-line table-entry-height)
964      (while (< column-number total-number-of-columns)
965	(setq here (point))
966	(insert-rectangle
967	 (eval (intern
968		(concat texinfo-multitable-rectangle-name
969			(int-to-string column-number)))))
970	(goto-char here)
971	(end-of-line)
972	(setq column-number (1+ column-number))))
973    (kill-buffer texinfo-multitable-buffer-name)
974    (setq fill-column existing-fill-column)))
975
976
977(ptexinfmt-defun-if-broken texinfo-format-printindex ()
978  (let ((indexelts (symbol-value
979		    (cdr (assoc (texinfo-parse-arg-discard)
980				texinfo-indexvar-alist))))
981	opoint)
982    (insert "\n* Menu:\n\n")
983    (setq opoint (point))
984    (texinfo-print-index nil indexelts)
985
986    (if (memq system-type '(vax-vms windows-nt ms-dos))
987	(texinfo-sort-region opoint (point))
988      (shell-command-on-region opoint (point) "sort -fd" 1))))
989
990
991;; @copying ... @end copying
992;; that Emacs 21.4 and lesser and XEmacs don't support.
993(if (fboundp 'texinfo-copying)
994    nil
995  (defvar texinfo-copying-text ""
996    "Text of the copyright notice and copying permissions.")
997
998  (defun texinfo-copying ()
999    "Copy the copyright notice and copying permissions from the Texinfo file,
1000as indicated by the @copying ... @end copying command;
1001insert the text with the @insertcopying command."
1002    (let ((beg (progn (beginning-of-line) (point)))
1003	  (end  (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
1004      (setq texinfo-copying-text
1005	    (buffer-substring-no-properties
1006	     (save-excursion (goto-char beg) (forward-line 1) (point))
1007	     (save-excursion (goto-char end) (forward-line -1) (point))))
1008      (delete-region beg end)))
1009
1010  (defun texinfo-insertcopying ()
1011    "Insert the copyright notice and copying permissions from the Texinfo file,
1012which are indicated by the @copying ... @end copying command."
1013    (insert (concat "\n" texinfo-copying-text)))
1014
1015  (defadvice texinfo-format-scan (before expand-@copying-section activate)
1016    "Extract @copying and replace @insertcopying with it."
1017    (goto-char (point-min))
1018    (when (search-forward "@copying" nil t)
1019      (texinfo-copying))
1020    (while (search-forward "@insertcopying" nil t)
1021      (delete-region (match-beginning 0) (match-end 0))
1022      (texinfo-insertcopying))))
1023
1024(provide 'ptexinfmt)
1025
1026;;; ptexinfmt.el ends here
1027