source: trunk/third/openssh/mdoc2man.pl @ 18759

Revision 18759, 9.7 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18758, which included commits to RCS files with non-trunk default branches.
Line 
1#!/usr/bin/perl
2###
3### Quick usage:  mdoc2man.pl < mdoc_manpage.8 > man_manpage.8
4###
5###
6###  Copyright (c) 2001 University of Illinois Board of Trustees
7###  Copyright (c) 2001 Mark D. Roth
8###  All rights reserved.
9###
10###  Redistribution and use in source and binary forms, with or without
11###  modification, are permitted provided that the following conditions
12###  are met:
13###  1. Redistributions of source code must retain the above copyright
14###     notice, this list of conditions and the following disclaimer.
15###  2. Redistributions in binary form must reproduce the above copyright
16###     notice, this list of conditions and the following disclaimer in the
17###     documentation and/or other materials provided with the distribution.
18###  3. All advertising materials mentioning features or use of this software
19###     must display the following acknowledgement:
20###     This product includes software developed by the University of
21###     Illinois at Urbana, and their contributors.
22###  4. The University nor the names of their
23###     contributors may be used to endorse or promote products derived from
24###     this software without specific prior written permission.
25###
26###  THIS SOFTWARE IS PROVIDED BY THE TRUSTEES AND CONTRIBUTORS ``AS IS'' AND
27###  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
28###  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
29###  ARE DISCLAIMED.  IN NO EVENT SHALL THE TRUSTEES OR CONTRIBUTORS BE LIABLE
30###  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
31###  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32###  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33###  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
34###  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
35###  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
36###  SUCH DAMAGE.
37###
38
39use strict;
40
41my ($name, $date, $id);
42my ($line);
43my ($optlist, $oldoptlist, $nospace, $enum, $synopsis);
44my ($reference, $block, $ext, $extopt, $literal);
45my (@refauthors, $reftitle, $refissue, $refdate, $refopt);
46
47
48$optlist = 0;           ### 1 = bullet, 2 = enum, 3 = tag, 4 = item
49$oldoptlist = 0;
50$nospace = 0;
51$synopsis = 0;
52$reference = 0;
53$block = 0;
54$ext = 0;
55$extopt = 0;
56$literal = 0;
57
58while ($line = <STDIN>)
59{
60        if ($line !~ /^\./)
61        {
62                print $line;
63                print ".br\n"
64                        if ($literal);
65                next;
66        }
67
68        $line =~ s/^\.//;
69
70        next
71                if ($line =~ m/\\"/);
72
73        $line = ParseMacro($line);
74        print($line)
75                if (defined $line);
76}
77
78
79
80sub ParseMacro # ($line)
81{
82        my ($line) = @_;
83        my (@words, $retval, $option, $parens);
84
85        @words = split(/\s+/, $line);
86        $retval = '';
87        $option = 0;
88        $parens = 0;
89
90#       print('@words = ', scalar(@words), ': ', join(' ', @words), "\n");
91
92        while ($_ = shift @words)
93        {
94#               print "WORD: $_\n";
95
96                next
97                        if (/^(Li|Pf)$/);
98
99                if (/^Xo$/)
100                {
101                        $ext = 1;
102                        $retval .= ' '
103                                if ($retval ne '' && $retval !~ m/[\n ]$/);
104                        next;
105                }
106
107                if (/^Xc$/)
108                {
109                        $ext = 0;
110                        $retval .= "\n"
111                                if (! $extopt);
112                        last;
113                }
114
115                if (/^Bd$/)
116                {
117                        $literal = 1
118                                if ($words[0] eq '-literal');
119                        $retval .= "\n";
120                        last;
121                }
122
123                if (/^Ed$/)
124                {
125                        $literal = 0;
126                        last;
127                }
128
129                if (/^Ns$/)
130                {
131                        $nospace = 1
132                                if (! $nospace);
133                        $retval =~ s/ $//;
134                        next;
135                }
136
137                if (/^No$/)
138                {
139                        $retval =~ s/ $//;
140                        $retval .= shift @words;
141                        next;
142                }
143
144                if (/^Dq$/)
145                {
146                        $retval .= '``';
147                        do
148                        {
149                                $retval .= (shift @words) . ' ';
150                        }
151                        while (@words > 0 && $words[0] !~ m/^[\.,]/);
152                        $retval =~ s/ $//;
153                        $retval .= '\'\'';
154                        $nospace = 1
155                                if (! $nospace && $words[0] =~ m/^[\.,]/);
156                        next;
157                }
158
159                if (/^(Sq|Ql)$/)
160                {
161                        $retval .= '`' . (shift @words) . '\'';
162                        $nospace = 1
163                                if (! $nospace && $words[0] =~ m/^[\.,]/);
164                        next;
165                }
166
167#               if (/^Ic$/)
168#               {
169#                       $retval .= '\\fB' . shift(@words) . '\\fP';
170#                       next;
171#               }
172
173                if (/^Oo$/)
174                {
175#                       $retval .= "[\\c\n";
176                        $extopt = 1;
177                        $nospace = 1
178                                if (! $nospace);
179                        $retval .= '[';
180                        next;
181                }
182
183                if (/^Oc$/)
184                {
185                        $extopt = 0;
186                        $retval .= ']';
187                        next;
188                }
189
190                $retval .= ' '
191                        if (! $nospace && $retval ne '' && $retval !~ m/[\n ]$/);
192                $nospace = 0
193                        if ($nospace == 1);
194
195                if (/^Dd$/)
196                {
197                        $date = join(' ', @words);
198                        return undef;
199                }
200
201                if (/^Dt$/)
202                {
203                        $id = join(' ', @words);
204                        return undef;
205                }
206
207                if (/^Os$/)
208                {
209                        $retval .= '.TH '
210                                . $id
211                                . " \"$date\" \""
212                                . join(' ', @words)
213                                . "\"";
214                        last;
215                }
216
217                if (/^Sh$/)
218                {
219                        $retval .= '.SH';
220                        if ($words[0] eq 'SYNOPSIS')
221                        {
222                                $synopsis = 1;
223                        }
224                        else
225                        {
226                                $synopsis = 0;
227                        }
228                        next;
229                }
230
231                if (/^Xr$/)
232                {
233                        $retval .= '\\fB' . (shift @words) .
234                                '\\fP(' . (shift @words) . ')'
235                                . (shift @words);
236                        last;
237                }
238
239                if (/^Rs/)
240                {
241                        @refauthors = ();
242                        $reftitle = '';
243                        $refissue = '';
244                        $refdate = '';
245                        $refopt = '';
246                        $reference = 1;
247                        last;
248                }
249
250                if (/^Re/)
251                {
252                        $retval .= "\n";
253
254                        # authors
255                        while (scalar(@refauthors) > 1)
256                        {
257                                $retval .= shift(@refauthors) . ', ';
258                        }
259                        $retval .= 'and '
260                                if ($retval ne '');
261                        $retval .= shift(@refauthors);
262                       
263                        # title
264                        $retval .= ', \\fI' . $reftitle . '\\fP';
265
266                        # issue
267                        $retval .= ', ' . $refissue
268                                if ($refissue ne '');
269
270                        # date
271                        $retval .= ', ' . $refdate
272                                if ($refdate ne '');
273
274                        # optional info
275                        $retval .= ', ' . $refopt
276                                if ($refopt ne '');
277
278                        $retval .= ".\n";
279
280                        $reference = 0;
281                        last;
282                }
283
284                if ($reference)
285                {
286                        if (/^%A$/)
287                        {
288                                unshift(@refauthors, join(' ', @words));
289                                last;
290                        }
291
292                        if (/^%T$/)
293                        {
294                                $reftitle = join(' ', @words);
295                                $reftitle =~ s/^"//;
296                                $reftitle =~ s/"$//;
297                                last;
298                        }
299
300                        if (/^%N$/)
301                        {
302                                $refissue = join(' ', @words);
303                                last;
304                        }
305
306                        if (/^%D$/)
307                        {
308                                $refdate = join(' ', @words);
309                                last;
310                        }
311
312                        if (/^%O$/)
313                        {
314                                $refopt = join(' ', @words);
315                                last;
316                        }
317                }
318
319                if (/^Nm$/)
320                {
321                        my $n = $name;
322                        $n = shift @words
323                                if (@words > 0);
324                        $name = $n unless $name;
325                        $retval .= ".br\n"
326                                if ($synopsis);
327                        $retval .= "\\fB$n\\fP";
328                        $nospace = 1
329                                if (! $nospace && $words[0] =~ m/^[\.,]/);
330                        next;
331                }
332
333                if (/^Nd$/)
334                {
335                        $retval .= '\\-';
336                        next;
337                }
338
339                if (/^Fl$/)
340                {
341                        $retval .= '\\fB\\-' . (shift @words) . '\\fP';
342                        $nospace = 1
343                                if (! $nospace && $words[0] =~ m/^[\.,]/);
344                        next;
345                }
346
347                if (/^Ar$/)
348                {
349                        $retval .= '\\fI';
350                        if (! defined $words[0])
351                        {
352                                $retval .= 'file ...\\fP';
353                        }
354                        else
355                        {
356                                $retval .= shift(@words) . '\\fP';
357                                while ($words[0] eq '|')
358                                {
359                                        $retval .= ' ' . shift(@words);
360                                        $retval .= ' \\fI' . shift(@words);
361                                        $retval .= '\\fP';
362                                }
363                        }
364                        $nospace = 1
365                                if (! $nospace && $words[0] =~ m/^[\.,]/);
366                        next;
367                }
368
369                if (/^Cm$/)
370                {
371                        $retval .= '\\fB' . (shift @words) . '\\fP';
372                        while ($words[0] =~ m/^[\.,:)]$/)
373                        {
374                                $retval .= shift(@words);
375                        }
376                        next;
377                }
378
379                if (/^Op$/)
380                {
381                        $option = 1;
382                        $nospace = 1
383                                if (! $nospace);
384                        $retval .= '[';
385#                       my $tmp = pop(@words);
386#                       $tmp .= ']';
387#                       push(@words, $tmp);
388                        next;
389                }
390
391                if (/^Pp$/)
392                {
393                        $retval .= "\n";
394                        next;
395                }
396
397                if (/^Ss$/)
398                {
399                        $retval .= '.SS';
400                        next;
401                }
402
403                if (/^Pa$/ && ! $option)
404                {
405                        $retval .= '\\fI';
406                        $retval .= '\\&'
407                                if ($words[0] =~ m/^\./);
408                        $retval .= (shift @words) . '\\fP';
409                        while ($words[0] =~ m/^[\.,:;)]$/)
410                        {
411                                $retval .= shift(@words);
412                        }
413#                       $nospace = 1
414#                               if (! $nospace && $words[0] =~ m/^[\.,:)]/);
415                        next;
416                }
417
418                if (/^Dv$/)
419                {
420                        $retval .= '.BR';
421                        next;
422                }
423
424                if (/^(Em|Ev)$/)
425                {
426                        $retval .= '.IR';
427                        next;
428                }
429
430                if (/^Pq$/)
431                {
432                        $retval .= '(';
433                        $nospace = 1;
434                        $parens = 1;
435                        next;
436                }
437
438                if (/^(S[xy])$/)
439                {
440                        $retval .= '.B ' . join(' ', @words);
441                        last;
442                }
443
444                if (/^Ic$/)
445                {
446                        $retval .= '\\fB';
447                        while (defined $words[0]
448                                && $words[0] !~ m/^[\.,]/)
449                        {
450                                if ($words[0] eq 'Op')
451                                {
452                                        shift(@words);
453                                        $retval .= '[';
454                                        my $tmp = pop(@words);
455                                        $tmp .= ']';
456                                        push(@words, $tmp);
457                                        next;
458                                }
459                                if ($words[0] eq 'Ar')
460                                {
461                                        shift @words;
462                                        $retval .= '\\fI';
463                                        $retval .= shift @words;
464                                        $retval .= '\\fP';
465                                }
466                                else
467                                {
468                                        $retval .= shift @words;
469                                }
470                                $retval .= ' '
471                                        if (! $nospace);
472                        }
473                        $retval =~ s/ $//;
474                        $retval .= '\\fP';
475                        $retval .= shift @words
476                                if (defined $words[0]);
477                        last;
478                }
479
480                if (/^Bl$/)
481                {
482                        $oldoptlist = $optlist;
483                        if ($words[0] eq '-bullet')
484                        {
485                                $optlist = 1;
486                        }
487                        elsif ($words[0] eq '-enum')
488                        {
489                                $optlist = 2;
490                                $enum = 0;
491                        }
492                        elsif ($words[0] eq '-tag')
493                        {
494                                $optlist = 3;
495                        }
496                        elsif ($words[0] eq '-item')
497                        {
498                                $optlist = 4;
499                        }
500                        last;
501                }
502
503                if (/^El$/)
504                {
505                        $optlist = $oldoptlist;
506                        next;
507                }
508
509                if ($optlist && /^It$/)
510                {
511                        if ($optlist == 1)
512                        {
513                                # bullets
514                                $retval .= '.IP \\(bu';
515                                next;
516                        }
517
518                        if ($optlist == 2)
519                        {
520                                # enum
521                                $retval .= '.IP ' . (++$enum) . '.';
522                                next;
523                        }
524
525                        if ($optlist == 3)
526                        {
527                                # tags
528                                $retval .= ".TP\n";
529                                if ($words[0] =~ m/^(Pa|Ev)$/)
530                                {
531                                        shift @words;
532                                        $retval .= '.B';
533                                }
534                                next;
535                        }
536
537                        if ($optlist == 4)
538                        {
539                                # item
540                                $retval .= ".IP\n";
541                                next;
542                        }
543
544                        next;
545                }
546
547                if (/^Sm$/)
548                {
549                        if ($words[0] eq 'off')
550                        {
551                                $nospace = 2;
552                        }
553                        elsif ($words[0] eq 'on')
554                        {
555#                               $retval .= "\n";
556                                $nospace = 0;
557                        }
558                        shift @words;
559                        next;
560                }
561
562                $retval .= "$_";
563        }
564
565        return undef
566                if ($retval eq '.');
567
568        $retval =~ s/^\.([^a-zA-Z])/$1/;
569#       $retval =~ s/ $//;
570
571        $retval .= ')'
572                if ($parens == 1);
573
574        $retval .= ']'
575                if ($option == 1);
576
577#       $retval .= ' '
578#               if ($nospace && $retval ne '' && $retval !~ m/\n$/);
579
580#       $retval .= ' '
581#               if ($extended && $retval !~ m/ $/);
582
583        $retval .= ' '
584                if ($ext && ! $extopt && $retval !~ m/ $/);
585
586        $retval .= "\n"
587                if (! $ext && ! $extopt && $retval ne '' && $retval !~ m/\n$/);
588
589        return $retval;
590}
591
592
Note: See TracBrowser for help on using the repository browser.