Mercurial > emacs
annotate lisp/nxml/rng-maint.el @ 87323:24f44404f3aa
(rng-update-autoloads, rng-byte-compile-load)
(rng-format-manual, rng-write-version): Do not autoload.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Wed, 19 Dec 2007 00:55:16 +0000 |
parents | d41a39f17964 |
children | 8c94facb0a5e |
rev | line source |
---|---|
86361 | 1 ;;; rng-maint.el --- commands for RELAX NG maintainers |
2 | |
86548 | 3 ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. |
86361 | 4 |
5 ;; Author: James Clark | |
6 ;; Keywords: XML, RelaxNG | |
7 | |
86548 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 3, or (at your option) | |
13 ;; any later version. | |
86361 | 14 |
86548 | 15 ;; GNU Emacs is distributed in the hope that it will be useful, |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
86361 | 19 |
86548 | 20 ;; You should have received a copy of the GNU General Public License |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
23 ;; Boston, MA 02110-1301, USA. | |
86361 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;;; Code: | |
28 | |
29 (require 'xmltok) | |
30 (require 'nxml-mode) | |
31 (require 'texnfo-upd) | |
32 | |
33 (defvar rng-dir (file-name-directory load-file-name)) | |
34 | |
35 (defconst rng-autoload-modules | |
36 '(xmltok | |
37 nxml-mode | |
38 nxml-uchnm | |
39 nxml-glyph | |
40 rng-cmpct | |
41 rng-maint | |
42 rng-valid | |
43 rng-xsd | |
44 rng-nxml)) | |
45 | |
46 (defun rng-update-autoloads () | |
47 "Update the autoloads in rng-auto.el." | |
48 (interactive) | |
49 (let* ((generated-autoload-file (expand-file-name "rng-auto.el" | |
50 rng-dir))) | |
51 (mapcar (lambda (x) | |
52 (update-file-autoloads | |
53 (expand-file-name (concat (symbol-name x) ".el") rng-dir))) | |
54 rng-autoload-modules))) | |
55 | |
56 | |
57 (defconst rng-compile-modules | |
58 '(xmltok | |
59 nxml-util | |
60 nxml-enc | |
61 nxml-glyph | |
62 nxml-rap | |
63 nxml-outln | |
64 nxml-mode | |
65 nxml-uchnm | |
66 nxml-ns | |
67 nxml-parse | |
68 nxml-maint | |
69 xsd-regexp | |
70 rng-util | |
71 rng-dt | |
72 rng-xsd | |
73 rng-uri | |
74 rng-pttrn | |
75 rng-cmpct | |
76 rng-match | |
77 rng-parse | |
78 rng-loc | |
79 rng-valid | |
80 rng-nxml | |
81 rng-maint)) | |
82 | |
83 (defun rng-byte-compile-load () | |
84 "Byte-compile and load all of the RELAX NG library in an appropriate order." | |
85 (interactive) | |
86 (mapcar (lambda (x) | |
87 (byte-compile-file (expand-file-name (concat (symbol-name x) ".el") | |
88 rng-dir) | |
89 t)) | |
90 rng-compile-modules)) | |
91 | |
92 | |
93 ;;; Conversion from XML to texinfo. | |
94 ;; This is all a hack and is just enough to make the conversion work. | |
95 ;; It's not intended for public use. | |
96 | |
97 (defvar rng-manual-base "nxml-mode") | |
98 (defvar rng-manual-xml (concat rng-manual-base ".xml")) | |
99 (defvar rng-manual-texi (concat rng-manual-base ".texi")) | |
100 (defvar rng-manual-info (concat rng-manual-base ".info")) | |
101 | |
102 (defun rng-format-manual () | |
103 "Create manual.texi from manual.xml." | |
104 (interactive) | |
105 (let ((xml-buf (find-file-noselect (expand-file-name rng-manual-xml | |
106 rng-dir))) | |
107 (texi-buf (find-file-noselect (expand-file-name rng-manual-texi | |
108 rng-dir)))) | |
109 (save-excursion | |
110 (set-buffer texi-buf) | |
111 (erase-buffer) | |
112 (let ((standard-output texi-buf)) | |
113 (princ (format "\\input texinfo @c -*- texinfo -*-\n\ | |
114 @c %%**start of header\n\ | |
115 @setfilename %s\n\ | |
116 @settitle \n\ | |
117 @c %%**end of header\n" rng-manual-info)) | |
118 (set-buffer xml-buf) | |
119 (goto-char (point-min)) | |
120 (xmltok-save | |
121 (xmltok-forward-prolog) | |
122 (rng-process-tokens)) | |
123 (princ "\n@bye\n")) | |
124 (set-buffer texi-buf) | |
125 (rng-manual-fixup) | |
126 (texinfo-insert-node-lines (point-min) (point-max) t) | |
127 (texinfo-all-menus-update) | |
128 (save-buffer)))) | |
129 | |
130 (defun rng-manual-fixup () | |
131 (goto-char (point-min)) | |
132 (search-forward "@top ") | |
133 (let ((pos (point))) | |
134 (search-forward "\n") | |
135 (let ((title (buffer-substring-no-properties pos (1- (point))))) | |
136 (goto-char (point-min)) | |
137 (search-forward "@settitle ") | |
138 (insert title) | |
139 (search-forward "@node") | |
140 (goto-char (match-beginning 0)) | |
141 (insert "@dircategory Emacs\n" | |
142 "@direntry\n* " | |
143 title | |
144 ": (" | |
145 rng-manual-info | |
146 ").\n@end direntry\n\n")))) | |
147 | |
148 (defvar rng-manual-inline-elements '(kbd key samp code var emph uref point)) | |
149 | |
150 (defun rng-process-tokens () | |
151 (let ((section-depth 0) | |
152 ;; stack of per-element space treatment | |
153 ;; t means keep, nil means discard, fill means no blank lines | |
154 (keep-space-stack (list nil)) | |
155 (ignore-following-newline nil) | |
156 (want-blank-line nil) | |
157 name startp endp data keep-space-for-children) | |
158 (while (xmltok-forward) | |
159 (cond ((memq xmltok-type '(start-tag empty-element end-tag)) | |
160 (setq startp (memq xmltok-type '(start-tag empty-element))) | |
161 (setq endp (memq xmltok-type '(end-tag empty-element))) | |
162 (setq name (intern (if startp | |
163 (xmltok-start-tag-qname) | |
164 (xmltok-end-tag-qname)))) | |
165 (setq keep-space-for-children nil) | |
166 (setq ignore-following-newline nil) | |
167 (cond ((memq name rng-manual-inline-elements) | |
168 (when startp | |
169 (when want-blank-line | |
170 (rng-manual-output-force-blank-line) | |
171 (when (eq want-blank-line 'noindent) | |
172 (princ "@noindent\n")) | |
173 (setq want-blank-line nil)) | |
174 (setq keep-space-for-children t) | |
175 (princ (format "@%s{" name))) | |
176 (when endp (princ "}"))) | |
177 ((eq name 'ulist) | |
178 (when startp | |
179 (rng-manual-output-force-blank-line) | |
180 (setq want-blank-line nil) | |
181 (princ "@itemize @bullet\n")) | |
182 (when endp | |
183 (rng-manual-output-force-new-line) | |
184 (setq want-blank-line 'noindent) | |
185 (princ "@end itemize\n"))) | |
186 ((eq name 'item) | |
187 (rng-manual-output-force-new-line) | |
188 (setq want-blank-line endp) | |
189 (when startp (princ "@item\n"))) | |
190 ((memq name '(example display)) | |
191 (when startp | |
192 (setq ignore-following-newline t) | |
193 (rng-manual-output-force-blank-line) | |
194 (setq want-blank-line nil) | |
195 (setq keep-space-for-children t) | |
196 (princ (format "@%s\n" name))) | |
197 (when endp | |
198 (rng-manual-output-force-new-line) | |
199 (setq want-blank-line 'noindent) | |
200 (princ (format "@end %s\n" name)))) | |
201 ((eq name 'para) | |
202 (rng-manual-output-force-new-line) | |
203 (when startp | |
204 (when want-blank-line | |
205 (setq want-blank-line t)) | |
206 (setq keep-space-for-children 'fill)) | |
207 (when endp (setq want-blank-line t))) | |
208 ((eq name 'section) | |
209 (when startp | |
210 (rng-manual-output-force-blank-line) | |
211 (when (eq section-depth 0) | |
212 (princ "@node Top\n")) | |
213 (princ "@") | |
214 (princ (nth section-depth '(top | |
215 chapter | |
216 section | |
217 subsection | |
218 subsubsection))) | |
219 (princ " ") | |
220 (setq want-blank-line nil) | |
221 (setq section-depth (1+ section-depth))) | |
222 (when endp | |
223 (rng-manual-output-force-new-line) | |
224 (setq want-blank-line nil) | |
225 (setq section-depth (1- section-depth)))) | |
226 ((eq name 'title) | |
227 (when startp | |
228 (setq keep-space-for-children 'fill)) | |
229 (when endp | |
230 (setq want-blank-line t) | |
231 (princ "\n")))) | |
232 (when startp | |
233 (setq keep-space-stack (cons keep-space-for-children | |
234 keep-space-stack))) | |
235 (when endp | |
236 (setq keep-space-stack (cdr keep-space-stack)))) | |
237 ((memq xmltok-type '(data | |
238 space | |
239 char-ref | |
240 entity-ref | |
241 cdata-section)) | |
242 (setq data nil) | |
243 (cond ((memq xmltok-type '(data space)) | |
244 (setq data (buffer-substring-no-properties xmltok-start | |
245 (point)))) | |
246 ((and (memq xmltok-type '(char-ref entity-ref)) | |
247 xmltok-replacement) | |
248 (setq data xmltok-replacement)) | |
249 ((eq xmltok-type 'cdata-section) | |
250 (setq data | |
251 (buffer-substring-no-properties (+ xmltok-start 9) | |
252 (- (point) 3))))) | |
253 (when (and data (car keep-space-stack)) | |
254 (setq data (replace-regexp-in-string "[@{}]" | |
255 "@\\&" | |
256 data | |
257 t)) | |
258 (when ignore-following-newline | |
259 (setq data (replace-regexp-in-string "\\`\n" "" data t))) | |
260 (setq ignore-following-newline nil) | |
261 ;; (when (eq (car keep-space-stack) 'fill) | |
262 ;; (setq data (replace-regexp-in-string "\n" " " data t))) | |
263 (when (eq want-blank-line 'noindent) | |
264 (setq data (replace-regexp-in-string "\\`\n*" "" data t))) | |
265 (when (> (length data) 0) | |
266 (when want-blank-line | |
267 (rng-manual-output-force-blank-line) | |
268 (when (eq want-blank-line 'noindent) | |
269 (princ "@noindent\n")) | |
270 (setq want-blank-line nil)) | |
271 (princ data)))) | |
272 )))) | |
273 | |
274 (defun rng-manual-output-force-new-line () | |
275 (save-excursion | |
276 (set-buffer standard-output) | |
277 (unless (eq (char-before) ?\n) | |
278 (insert ?\n)))) | |
279 | |
280 (defun rng-manual-output-force-blank-line () | |
281 (save-excursion | |
282 (set-buffer standard-output) | |
283 (if (eq (char-before) ?\n) | |
284 (unless (eq (char-before (1- (point))) ?\n) | |
285 (insert ?\n)) | |
286 (insert "\n\n")))) | |
287 | |
288 ;;; Versioning | |
289 | |
290 (defun rng-write-version () | |
291 (find-file "VERSION") | |
292 (erase-buffer) | |
293 (insert nxml-version "\n") | |
294 (save-buffer)) | |
295 | |
296 ;;; Timing | |
297 | |
298 (defun rng-time-to-float (time) | |
299 (+ (* (nth 0 time) 65536.0) | |
300 (nth 1 time) | |
301 (/ (nth 2 time) 1000000.0))) | |
302 | |
303 (defun rng-time-function (function &rest args) | |
304 (let* ((start (current-time)) | |
305 (val (apply function args)) | |
306 (end (current-time))) | |
307 (message "%s ran in %g seconds" | |
308 function | |
309 (- (rng-time-to-float end) | |
310 (rng-time-to-float start))) | |
311 val)) | |
312 | |
313 (defun rng-time-tokenize-buffer () | |
314 (interactive) | |
315 (rng-time-function 'rng-tokenize-buffer)) | |
316 | |
317 (defun rng-tokenize-buffer () | |
318 (save-excursion | |
319 (goto-char (point-min)) | |
320 (xmltok-save | |
321 (xmltok-forward-prolog) | |
322 (while (xmltok-forward))))) | |
323 | |
324 (defun rng-time-validate-buffer () | |
325 (interactive) | |
326 (rng-time-function 'rng-validate-buffer)) | |
327 | |
86851
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
328 (defvar rng-error-count) |
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
329 (defvar rng-validate-up-to-date-end) |
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
330 (declare-function rng-clear-cached-state "rng-valid" (start end)) |
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
331 (declare-function rng-clear-overlays "rng-valid" (beg end)) |
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
332 (declare-function rng-clear-conditional-region "rng-valid" ()) |
86866
d41a39f17964
(rng-do-some-validation): Fix declaration.
Glenn Morris <rgm@gnu.org>
parents:
86851
diff
changeset
|
333 (declare-function rng-do-some-validation "rng-valid" |
d41a39f17964
(rng-do-some-validation): Fix declaration.
Glenn Morris <rgm@gnu.org>
parents:
86851
diff
changeset
|
334 (&optional continue-p-function)) |
86851
321f32eb4bf5
* erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
86548
diff
changeset
|
335 |
86361 | 336 (defun rng-validate-buffer () |
337 (save-restriction | |
338 (widen) | |
339 (nxml-with-unmodifying-text-property-changes | |
340 (rng-clear-cached-state (point-min) (point-max))) | |
341 ;; 1+ to clear empty overlays at (point-max) | |
342 (rng-clear-overlays (point-min) (1+ (point-max)))) | |
343 (setq rng-validate-up-to-date-end 1) | |
344 (rng-clear-conditional-region) | |
345 (setq rng-error-count 0) | |
346 (while (rng-do-some-validation | |
347 (lambda () t)))) | |
348 | |
86379 | 349 ;; arch-tag: 4b8c6143-daac-4888-9c61-9bea6f935f17 |
86361 | 350 ;;; rng-maint.el ends here |