File: _nroff.tcl

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (182 lines) | stat: -rw-r--r-- 5,870 bytes parent folder | download | duplicates (4)
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
# -*- tcl -*-
#
# -- nroff commands
#
# Copyright (c) 2003-2019 Andreas Kupries <andreas_kupries@sourceforge.net>

################################################################
# nroff specific commands
#
# All dot-commands (f.e. .PP) are returned with a leading \n\1,
# enforcing that they are on a new line and will be protected as markup.
# Any empty line created because of this is filtered out in the 
# post-processing step.


proc nr_lp      {}          {return \n\1.LP}
proc nr_ta      {{text {}}} {return "\1.ta$text"}
proc nr_bld     {}          {return \1\\fB}
proc nr_bldt    {t}         {return "\n\1.B $t\n"}
proc nr_ul      {}          {return \1\\fI}
proc nr_rst     {}          {return \1\\fR}
proc nr_p       {}          {return \n\1.PP\n}
proc nr_comment {text}      {return "\1'\1\\\" [join [split $text \n] "\n\1'\1\\\" "]"} ; # "
proc nr_enum    {num}       {nr_item " \[$num\]"}
proc nr_item    {{text {}}} {return "\n\1.IP$text"}
proc nr_vspace  {}          {return \n\1.sp\n}
proc nr_blt     {text}      {return "\n\1.TP\n$text"}
proc nr_bltn    {n text}    {return "\n\1.TP $n\n$text"}
proc nr_in      {}          {return \n\1.RS}
proc nr_out     {}          {return \n\1.RE}
proc nr_nofill  {}          {return \n\1.nf}
proc nr_fill    {}          {return \n\1.fi}
proc nr_title   {text}      {return "\n\1.TH $text"}
proc nr_include {file}      {return "\n\1.so $file"}
proc nr_bolds   {}          {return \n\1.BS}
proc nr_bolde   {}          {return \n\1.BE}
proc nr_read    {fn}        {return [nroffMarkup [dt_read $fn]]}
proc nr_cs      {}          {return \n\1.CS\n}
proc nr_ce      {}          {return \n\1.CE\n}

proc nr_section {name} {
    if {![regexp {[ 	]} $name]} {
	return "\n\1.SH [string toupper $name]"
    }
    return "\n\1.SH \"[string toupper $name]\""
}
proc nr_subsection {name}   {
    if {![regexp {[ 	]} $name]} {
	return "\n\1.SS [string toupper $name]"
    }
    return "\n\1.SS \"[string toupper $name]\""
}


################################################################

# Handling of nroff special characters in content:
#
# Plain text is initially passed through unescaped;
# internally-generated markup is protected by preceding it with \1.
# The final PostProcess step strips the escape character from
# real markup and replaces unadorned special characters in content
# with proper escapes.
#

global   markupMap
set      markupMap [list \
	"\\"   "\1\\" \
	"'"    "\1'" \
	"."    "\1." \
	"\\\\" "\\"]
global   finalMap
set      finalMap [list \
	"\1\\" "\\" \
	"\1'"  "'" \
	"\1."  "." \
        "."    "\\&." \
	"\\"   "\\\\"]
global   textMap
set      textMap [list "\\" "\\\\"]


proc nroffEscape {text} {
    global textMap
    return [string map $textMap $text]
}

# markup text --
#	Protect markup characters in $text.
#	These will be stripped out in PostProcess.
#
proc nroffMarkup {text} {
    global markupMap
    return [string map $markupMap $text]
}

proc nroff_postprocess {nroff} {
    global finalMap

    # Postprocessing final nroff text.
    # - Strip empty lines out of the text
    # - Remove leading and trailing whitespace from lines.
    # - Exceptions to the above: Keep empty lines and leading
    #   whitespace when in verbatim sections (no-fill-mode)

    set nfMode   [list \1.nf \1.CS]	; # commands which start no-fill mode
    set fiMode   [list \1.fi \1.CE]	; # commands which terminate no-fill mode
    set lines    [list]         ; # Result buffer
    set verbatim 0              ; # Automaton mode/state

    foreach line [split $nroff "\n"] {
	#puts_stderr |[expr {$verbatim ? "VERB" : "    "}]|$line|

	if {!$verbatim} {
	    # Normal lines, not in no-fill mode.

	    if {[lsearch -exact $nfMode [split $line]] >= 0} {
		# no-fill mode starts after this line.
		set verbatim 1
	    }

	    # Ensure that empty lines are not added.
	    # This also removes leading and trailing whitespace.

	    if {![string length $line]} {continue}
	    set line [string trim $line]
	    if {![string length $line]} {continue}

	    if {[regexp {^\x1\\f[BI]\.} $line]} {
		# We found confusing formatting at the beginning of
		# the current line. We lift this line up and attach it
		# at the end of the last line to remove this
		# irregularity. Note that the regexp has to look for
		# the special 0x01 character as well to be sure that
		# the sequence in question truly is formatting.
		# [bug-3601370] Only lift & attach if last line is not
		# a directive

		set last  [lindex   $lines end]
		if { ! [string match "\1.*" $last] } {
		    #puts_stderr \tLIFT
		    set lines [lreplace $lines end end]
		    set line "$last $line"
		}
	    } elseif {[string match {[']*} $line]} {
		# Apostrophes at the beginning of a line have to be
		# quoted to prevent misinterpretation as comments.
		# The true comments and are quoted with \1 already and
		# will therefore not detected by the code here.
		# puts_stderr \tQUOTE
		set line \1\\$line
	    } ; # We are not handling dots at the beginning of a line here.
	    #   # We are handling them in the finalMap which will quote _all_
	    #   # dots in a text with a zero-width escape (\&).
	} else {
	    # No-fill mode. We remove trailing whitespace, but keep
	    # leading whitespace and empty lines.

	    if {[lsearch -exact $fiMode [split $line]] >= 0} {
		# Normal mode resumes after this line.
		set verbatim 0
	    }
	    set line [string trimright $line]
	}
	lappend lines $line
    }

    set lines [join $lines "\n"]

    # Now remove all superfluous .IP commands (empty paragraphs). The
    # first identity mapping is present to avoid smashing a man macro
    # definition.

    lappend map	\n\1.IP\n\1.\1.\n  \n\1.IP\n\1.\1.\n
    lappend map \n\1.IP\n\1.       \n\1.

    set lines [string map $map $lines]

    # Return the modified result buffer
    return [string trim [string map $finalMap $lines]]\n
}