Mercurial > hg > xemacs-beta

comparison lisp/psgml/psgml-parse.el @ 78:c7528f8e288d r20-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b34
author cvs
date Mon, 13 Aug 2007 09:05:42 +0200
parents 54cc21c15cbb
children 1ce6082ce73f
comparison
equal deleted inserted replaced
77:6cb4f478e7bc 78:c7528f8e288d
1 ;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support 1 ;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support
2 ;; $Id: psgml-parse.el,v 1.1.1.2 1996/12/21 20:50:41 steve Exp $ 2 ;; $Id: psgml-parse.el,v 1.2 1997/01/03 03:10:27 steve Exp $
3 3
4 ;; Copyright (C) 1994, 1995 Lennart Staflin 4 ;; Copyright (C) 1994, 1995 Lennart Staflin
5 5
6 ;; Author: Lennart Staflin <lenst@lysator.liu.se> 6 ;; Author: Lennart Staflin <lenst@lysator.liu.se>
7 ;; Acknowledgment: 7 ;; Acknowledgment:
444 (` (cdr (, n)))) 444 (` (cdr (, n))))
445 445
446 446
447 ;;; Using states 447 ;;; Using states
448 448
449 (defsubst sgml-final (state)
450 (if (sgml-normal-state-p state)
451 (sgml-state-final-p state)
452 (sgml-final-and state)))
453
454 (defun sgml-final-and (state)
455 (and (sgml-final (sgml-and-state-substate state))
456 (loop for s in (sgml-and-state-dfas state)
457 always (sgml-state-final-p s))
458 (sgml-state-final-p (sgml-and-state-next state))))
459
449 ;; get-move: State x Token --> State|nil 460 ;; get-move: State x Token --> State|nil
450 461
451 (defsubst sgml-get-move (state token) 462 (defsubst sgml-get-move (state token)
452 "Return a new state or nil, after traversing TOKEN from STATE." 463 "Return a new state or nil, after traversing TOKEN from STATE."
453 (cond 464 (cond
463 token 474 token
464 (sgml-and-node-next dest))))))) 475 (sgml-and-node-next dest)))))))
465 (t ;state is a and-state 476 (t ;state is a and-state
466 (sgml-get-and-move state token)))) 477 (sgml-get-and-move state token))))
467 478
468 (defsubst sgml-final (state)
469 (if (sgml-normal-state-p state)
470 (sgml-state-final-p state)
471 (sgml-final-and state)))
472
473 (defun sgml-get-and-move (state token) 479 (defun sgml-get-and-move (state token)
474 ;; state is a and-state 480 ;; state is a and-state
475 (let ((m (sgml-get-move (sgml-and-state-substate state) token))) 481 (let ((m (sgml-get-move (sgml-and-state-substate state) token)))
476 (cond (m (cons m (cdr state))) 482 (cond (m (cons m (cdr state)))
477 ((sgml-final (sgml-and-state-substate state)) 483 ((sgml-final (sgml-and-state-substate state))
504 (sgml-tokens-of-moves (sgml-state-reqs state)) 510 (sgml-tokens-of-moves (sgml-state-reqs state))
505 (or (sgml-required-tokens (sgml-and-state-substate state)) 511 (or (sgml-required-tokens (sgml-and-state-substate state))
506 (loop for s in (sgml-and-state-dfas state) 512 (loop for s in (sgml-and-state-dfas state)
507 nconc (sgml-tokens-of-moves (sgml-state-reqs s))) 513 nconc (sgml-tokens-of-moves (sgml-state-reqs s)))
508 (sgml-tokens-of-moves (sgml-state-reqs (sgml-and-state-next state)))))) 514 (sgml-tokens-of-moves (sgml-state-reqs (sgml-and-state-next state))))))
509
510
511 (defun sgml-final-and (state)
512 (and (sgml-final (sgml-and-state-substate state))
513 (loop for s in (sgml-and-state-dfas state)
514 always (sgml-state-final-p s))
515 (sgml-state-final-p (sgml-and-state-next state))))
516 515
517 (defun sgml-optional-tokens (state) 516 (defun sgml-optional-tokens (state)
518 (if (sgml-normal-state-p state) 517 (if (sgml-normal-state-p state)
519 (sgml-tokens-of-moves (sgml-state-opts state)) 518 (sgml-tokens-of-moves (sgml-state-opts state))
520 (nconc 519 (nconc
1205 (sgml-push-to-entity dtd-file) 1204 (sgml-push-to-entity dtd-file)
1206 (sgml-check-dtd-subset) 1205 (sgml-check-dtd-subset)
1207 (sgml-pop-entity) 1206 (sgml-pop-entity)
1208 (erase-buffer) 1207 (erase-buffer)
1209 ;; For XEmacs-20.0/Mule 1208 ;; For XEmacs-20.0/Mule
1210 (setq file-coding-system 'no-conversion) 1209 (setq file-coding-system 'noconv)
1211 (sgml-write-dtd sgml-dtd-info to-file) 1210 (sgml-write-dtd sgml-dtd-info to-file)
1212 t)) 1211 t))
1213 1212
1214 (defun sgml-check-entities (params1 params2) 1213 (defun sgml-check-entities (params1 params2)
1215 "Check that PARAMS1 is compatible with PARAMS2." 1214 "Check that PARAMS1 is compatible with PARAMS2."
1233 1232
1234 (defun sgml-bdtd-merge () 1233 (defun sgml-bdtd-merge ()
1235 "Merge the binary coded dtd in the current buffer with the current dtd. 1234 "Merge the binary coded dtd in the current buffer with the current dtd.
1236 The current dtd is the variable sgml-dtd-info. Return t if mereged 1235 The current dtd is the variable sgml-dtd-info. Return t if mereged
1237 was successfull or nil if failed." 1236 was successfull or nil if failed."
1238 (setq file-coding-system 'no-conversion) 1237 (setq file-coding-system 'noconv)
1239 (goto-char (point-min)) 1238 (goto-char (point-min))
1240 (sgml-read-sexp) ; skip filev 1239 (sgml-read-sexp) ; skip filev
1241 (let ((dependencies (sgml-read-sexp)) 1240 (let ((dependencies (sgml-read-sexp))
1242 (parameters (sgml-read-sexp)) 1241 (parameters (sgml-read-sexp))
1243 (gc-cons-threshold (max gc-cons-threshold 500000)) 1242 (gc-cons-threshold (max gc-cons-threshold 500000))
1964 (sgml-trace-lookup "Start looking for %s entity %s public %s system %s" 1963 (sgml-trace-lookup "Start looking for %s entity %s public %s system %s"
1965 (or type "-") 1964 (or type "-")
1966 (or name "?") 1965 (or name "?")
1967 pubid 1966 pubid
1968 (sgml-extid-sysid extid)) 1967 (sgml-extid-sysid extid))
1969 (or (if sgml-system-identifiers-are-preferred 1968 (or (if (and sgml-system-identifiers-are-preferred
1970 (sgml-lookup-sysid-as-file extid)) 1969 (sgml-extid-sysid extid))
1970 (or (sgml-lookup-sysid-as-file extid)
1971 (sgml-path-lookup ;Try the path also, but only using sysid
1972 (sgml-make-extid nil (sgml-extid-sysid extid))
1973 nil nil)))
1971 (sgml-catalog-lookup sgml-current-localcat pubid type name) 1974 (sgml-catalog-lookup sgml-current-localcat pubid type name)
1972 (sgml-catalog-lookup sgml-catalog-files pubid type name) 1975 (sgml-catalog-lookup sgml-catalog-files pubid type name)
1973 (if (not sgml-system-identifiers-are-preferred) 1976 (if (not sgml-system-identifiers-are-preferred)
1974 (sgml-lookup-sysid-as-file extid)) 1977 (sgml-lookup-sysid-as-file extid))
1975 (sgml-path-lookup extid type name)))) 1978 (sgml-path-lookup extid type name))))
2363 (set-buffer sgml-scratch-buffer) 2366 (set-buffer sgml-scratch-buffer)
2364 ;; For MULE to not misinterpret binary data set the mc-flag 2367 ;; For MULE to not misinterpret binary data set the mc-flag
2365 ;; (reported by Jeffrey Friedl <jfriedl@nff.ncl.omron.co.jp>) 2368 ;; (reported by Jeffrey Friedl <jfriedl@nff.ncl.omron.co.jp>)
2366 (setq mc-flag nil) 2369 (setq mc-flag nil)
2367 ;; For XEmacs 20.0/Mule 2370 ;; For XEmacs 20.0/Mule
2368 (setq file-coding-system 'no-conversion) 2371 (setq file-coding-system 'noconv)
2369 (when (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer)) 2372 (when (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer))
2370 (make-local-variable 'sgml-scratch-buffer) 2373 (make-local-variable 'sgml-scratch-buffer)
2371 (setq sgml-scratch-buffer nil)) 2374 (setq sgml-scratch-buffer nil))
2372 (when after-change-function ;*** 2375 (when after-change-function ;***
2373 (message "OOPS: after-change-function not NIL in scratch buffer %s: %s" 2376 (message "OOPS: after-change-function not NIL in scratch buffer %s: %s"
3638 3641
3639 (defun sgml-modify-dtd (modifier) 3642 (defun sgml-modify-dtd (modifier)
3640 (setq sgml-dtd-info (sgml-pstate-dtd sgml-buffer-parse-state) 3643 (setq sgml-dtd-info (sgml-pstate-dtd sgml-buffer-parse-state)
3641 sgml-top-tree (sgml-pstate-top-tree sgml-buffer-parse-state)) 3644 sgml-top-tree (sgml-pstate-top-tree sgml-buffer-parse-state))
3642 (sgml-set-global) 3645 (sgml-set-global)
3643 ;;*** what is sgml-current-tree now? 3646 (setq sgml-current-tree sgml-top-tree)
3644 (while (stringp (cadr modifier)) ; Loop thru the context elements 3647 (while (stringp (cadr modifier)) ; Loop thru the context elements
3645 (let ((et (sgml-lookup-eltype (car modifier)))) 3648 (let ((et (sgml-lookup-eltype (car modifier))))
3646 (sgml-open-element et nil (point-min) (point-min)) 3649 (sgml-open-element et nil (point-min) (point-min))
3647 (setq modifier (cdr modifier)))) 3650 (setq modifier (cdr modifier))))
3648 3651