File: linuxdoc.scm

package info (click to toggle)
sdc 1.0.8beta-8
  • links: PTS
  • area: contrib
  • in suites: slink
  • size: 1,400 kB
  • ctags: 874
  • sloc: lisp: 8,120; ansic: 967; makefile: 671; perl: 136; sh: 50
file content (195 lines) | stat: -rw-r--r-- 5,488 bytes parent folder | download
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
183
184
185
186
187
188
189
190
191
192
193
194
195
(define (data->string s)
  (apply string-append (map data-token-data (filter is-data-token? s))))

(define skip-element
  (rdp-cond*
   `((#(ENDTAG)
      (#(STARTTAG) ,(rdp-repll '() (rdp-call skip-element)))
      (#() ,(rdp-skip 1))))))

(define linuxdoc-descrip
  (let ((text (rdp-call linuxdoc-text)))
    (rdp-repll
     '(#(STARTTAG DESC ()) #(ENDTAG DESC))
     (rdp-cond*
      `((#(STARTTAG TAG) ,(rdp-repll '(#(STARTTAG DT ()) #(ENDTAG DT)) text)
			 ,(rdp-wrap '#(STARTTAG DD ()) '#(ENDTAG DD) text)
			 )
	(#(STARTTAG P) ,(rdp-skip 1))
	(#(ENDTAG P) ,(rdp-skip 1))
	(#(DATA) ,(rdp-skip 1))
	)))))

(define linuxdoc-text
  (rdp-cond*
   `((#((DATA PI)) ,pass-token-action)
     (#(ENDTAG))
     (#(STARTTAG (TSCREEN LQ))
      ,(rdp-repll '(#(STARTTAG QUOTE (#(STYLE TOKEN ("DEFAULT"))))
		    #(ENDTAG QUOTE))
		  (rdp-call linuxdoc-text)))
     (#(STARTTAG P)
      ,(rdp-repll '((#(STARTTAG P ()) #(ENDTAG P)))
		  (rdp-call linuxdoc-text)))

     (#(STARTTAG ITEMIZE) ,(rdp-repll '(#(STARTTAG LIST ()) #(ENDTAG LIST))
				      (rdp-call linuxdoc-text)))

     (#(STARTTAG DESCRIP) ,linuxdoc-descrip)

     (#(STARTTAG SF) ,(rdp-repll '()
				 (rdp-call linuxdoc-text)))
     (#(STARTTAG CPARAM) ,(rdp-repll '(#(STARTTAG TT ()) #(ENDTAG TT))
				     (rdp-call linuxdoc-text)))
     (#(STARTTAG SL) ,(rdp-repll '(#(STARTTAG IT ()) #(ENDTAG IT))
				 (rdp-call linuxdoc-text)))

     (#(STARTTAG REF)
      ,(rdp-repll (if (equal? doc-output "html")
		      (lambda (t)
			`((#(STARTTAG REF (#(T TOKEN ("X")) . ,(token-args t)))
			   #(DATA ,(xatv t 'NAME)))
			  #(ENDTAG REF)))
		      (lambda (t)
			`((#(DATA ,(xatv t 'NAME))
			   #(DATA " (")
			   #(STARTTAG REF (#(T TOKEN ("X")) . ,(token-args t))))
			  (#(ENDTAG REF) #(DATA ")")))))
		  rdp-leave))

     (#(STARTTAG PAGEREF)
      ,(rdp-repll (lambda (t) `(" Page of " ,(xatv t 'ID))) rdp-leave))

     (#(STARTTAG URL)
      ,(rdp-repll (if (equal? doc-output "html")
		      (lambda (t)
			`((#(STARTTAG REF (#(T TOKEN ("U"))
					   #(ID CDATA ,(xatv t 'URL))))
			   #(DATA ,(xatv t 'NAME)))
			  #(ENDTAG REF)))
		      (lambda (t)
			`((#(DATA ,(xatv t 'NAME))
			   #(DATA " (")
			   #(STARTTAG REF (#(T TOKEN ("U"))
					   #(ID CDATA ,(xatv t 'URL))))
			   #(ENDTAG REF)
			   #(DATA ") "))
			  #f)))
		  rdp-leave))

     (#(STARTTAG HTMLURL)		; nur id, wenn html
      ,(rdp-repll (if (equal? doc-output "html")
		      (lambda (t)
			`((#(STARTTAG REF (#(T TOKEN ("U"))
					   #(ID CDATA ,(xatv t 'URL))))
			   #(DATA ,(xatv t 'NAME)))
			  #(ENDTAG REF)))
		      (lambda (t)
			`(#(DATA ,(xatv t 'NAME)))))
		  rdp-leave))
     (#(STARTTAG (IDX CDX))
      ,(rdp-map1
	(lambda (id)
	  (stream `#(STARTTAG INDEX (#(ID CDATA ,(data->string id))
				     #(SUB IMPLIED #f)))
		  '#(ENDTAG INDEX)))
	(rdp-repll '() (rdp-call linuxdoc-text))))

     (#(STARTTAG COMMENT)
      ,(rdp-repll '(#(STARTTAG NOTE ()) #(ENDTAG NOTE))
		  (rdp-call linuxdoc-text)))

     (#(STARTTAG (PH EPS HLINE TABULAR F DM EQ))
      ,(rdp-repll (lambda (t)
		    (message 0 "Skipping element " t)
		    '())
		  (rdp-call linuxdoc-text)))

     ; BE CAREFULL ABOUT THE FOLLOWING LINES
     (#(STARTTAG (TAG)))
     (#(STARTTAG (SECT SECT1 SECT2 CHAPT)))
     (#(STARTTAG) ,(rdpp-keep (rdp-call linuxdoc-text))))))

(define linuxdoc-heading
  (rdpp-keep linuxdoc-text))

(define linuxdoc-header
  (rdp-cond
   `((#(STARTTAG HEADER) ,(rdp-repll '() skip-element)))))

(define linuxdoc-garbage
  (rdp-cond*
   `((#(STARTTAG (TOC LOF LOT)) ,(rdp-skip 2)))))

(define linuxdoc-division
  (rdp-begin
   (rdp-map
    (lambda (div heading)
      (let* ((heading (stream->list heading))
	     (labels (filter (start-gi? '(LABEL)) heading))
	     (id (if (eq? labels empty-stream)
		     '#(ID IMPLIED #f)
		     `#(ID CDATA ,(xatv (car labels) 'ID)))))
	(apply
	 stream
	 `#(STARTTAG DIVISION (,id #(LANG TOKEN ("EN"))))
	 (filter (lambda (t) (not (or ((start-gi? '(LABEL)) t)
				      ((end-gi? '(LABEL)) t))))
		 heading))))
    pass-token-action			; the division token
    linuxdoc-heading)
   linuxdoc-header
   linuxdoc-text
   (rdp-cond*
    `((#(STARTTAG (SECT SECT1 SECT2)) ,(rdp-call linuxdoc-division))))
   (rdp-skip 1)				; the original end tag (check?)
   (rdp-insert '#(ENDTAG DIVISION))))

(define linuxdoc->report
  (rdp-repll
   '(#f #f)
   (rdp-cond
    `((#(STARTTAG ARTICLE)
       ,(rdp-repll
	 '(#f #(ENDTAG REPORT))
	 (rdp-cond
	  `((#(STARTTAG TITLEPAG)
	     ,(rdp-repll
	       '()
	       (rdp-map
		(lambda (title author date abstract)
		  (stream-append
		   (stream
		    `#(STARTTAG
		       REPORT
		       (#(AUTHOR CDATA ,(data->string (stream->list author)))
			#(DATE CDATA  ,(data->string (stream->list date)))
			#(LANG TOKEN ("EN"))
			#(INST CDATA "")
			#(FACE TOKEN ("1C"))))
		    '#(STARTTAG HEADING ()))
		   title
		   (stream '#(ENDTAG HEADING))
		   abstract))
		(rdp-repll '() linuxdoc-text)
		(rdp-repll '() linuxdoc-text)
		(rdp-repll '() linuxdoc-text)
		(rdpp-keep linuxdoc-text)))
	     )))
	 linuxdoc-header
	 linuxdoc-garbage
	 linuxdoc-text
	 (rdp-cond*
	  `((#(STARTTAG SECT) ,linuxdoc-division)
	    (#(STARTTAG APPENDIX)
	     ,(rdp-skip 2)
	     ,(rdp-wrap '#(STARTTAG APPENDIX ()) '#(ENDTAG APPENDIX)
			(rdp-cond*
			 `((#(STARTTAG SECT) ,linuxdoc-division)
			   (#(ENDTAG))
			   (#() ,(rdp-watch #"\n linuxdoc: Took wron turn ")
				,(rdp-skip 1))))))
	    (#(ENDTAG))
	    (#() ,(rdp-watch #"\nlinuxdoc: Took wrong turn ")
		 ,(rdp-skip 1))
	    ))))))))