File: deweb.in

package info (click to toggle)
chktex 1.6.3-2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k, lenny
  • size: 944 kB
  • ctags: 521
  • sloc: ansic: 3,875; makefile: 277; sh: 179; perl: 92; lisp: 24
file content (122 lines) | stat: -rw-r--r-- 2,160 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#! @PERL5@
#  deweb v1.2, kills the C sections of a CWEB file, for passing to ChkTeX.
#  Copyright (C) 1996 Jens T. Berger Thielemann
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#  Contact the author at:
#		Jens Berger
#		Spektrumvn. 4
#		N-0666 Oslo
#		Norway
#		E-mail: <jensthi@ifi.uio.no>
#
#
#

print STDERR "DeWEB v1.2 - Copyright 1996 Jens T. Berger Thielemann\n";

undef $/;
$texmode = 1;
$_ = <>;

while(/\@/)
{
    &out($`);
    $_ = $';

    if(/^@/) {
	$_ = $';
	&out('@');
       	next;
    }

    if(/^([\s\n])/) {
	$_ = $';
	print "\n" if $1 eq "\n";
	$texmode = 1;
	next;
    }

    if(/^[cpd]/i) {
	$_ = $';
	$texmode = 0;
	next;
    }

    if(/^\,/i) {
	$_ = $';
        print '\,';
	next;
    }

    if(m!^/!) {
	$_ = $';
        print '\\\\';
	next;
    }

    if(/^[h\&\|\;\#\+]/i || /^i.*/i) {
	$_ = $';
	next;
    }

    if(/^\*[0-9\*]?((.|\n)*?\.)/) {
	$_ = $';
	print $1;
	$texmode = 1;
	next;
    }

    if(/^[<(^.t!]((.|\n)*?)\@\>/i) {
	$_ = $';
	print '{'.$1.'}';
	$texmode = 0;
	next;
    }

    if(/^[=]((.|\n)*?)\@\>/) {
	$_ = $';
	print &printnl($1);
	next;
    }

    if(/^[fsl](\s+\S+\s+\S+)|^\'(.|\n)*?\'|^\[((.|\n)*?)\@\]/i) {
	$_ = $';
	print &printnl($+);
	next;
    }

    @line = split(/\n/, $_, 2);
    print STDERR "Unknown opcode, ignored. Buffer:\n$line[0]\n";

}

print $_;

sub printnl {
    my($foo);
    if(defined $_[0]) {
	$foo = $_[0];
	$foo =~ s/.//g;
    } else {
	$foo = "";
    }
    $foo;
}

sub out {
    print $texmode? $_[0] : &printnl($_[0]);
}