Mercurial > hg > xemacs-beta

comparison lisp/psgml/psgml-parse.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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.4 1997/03/09 02:37:46 steve Exp $ 2 ;; $Id: psgml-parse.el,v 1.1.1.1 1996/12/18 22:43:36 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:
227 "Tree node of markup parsed. 227 "Tree node of markup parsed.
228 In case markup closed element this is different from sgml-current-tree. 228 In case markup closed element this is different from sgml-current-tree.
229 Only valid after `sgml-parse-to'.") 229 Only valid after `sgml-parse-to'.")
230 230
231 (defvar sgml-markup-start nil 231 (defvar sgml-markup-start nil
232 "Start point of markup being parsed.") 232 "Start point of markup beeing parsed.")
233 233
234 (defvar sgml-conref-flag nil 234 (defvar sgml-conref-flag nil
235 "This variable is set by `sgml-parse-attribute-specification-list' 235 "This variable is set by `sgml-parse-attribute-specification-list'
236 if a CONREF attribute is parsed.") 236 if a CONREF attribute is parsed.")
237 237
443 (defmacro sgml-and-node-dfas (n) 443 (defmacro sgml-and-node-dfas (n)
444 (` (cdr (, n)))) 444 (` (cdr (, n))))
445 445
446 446
447 ;;; Using states 447 ;;; Using states
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 448
460 ;; get-move: State x Token --> State|nil 449 ;; get-move: State x Token --> State|nil
461 450
462 (defsubst sgml-get-move (state token) 451 (defsubst sgml-get-move (state token)
463 "Return a new state or nil, after traversing TOKEN from STATE." 452 "Return a new state or nil, after traversing TOKEN from STATE."
510 (sgml-tokens-of-moves (sgml-state-reqs state)) 499 (sgml-tokens-of-moves (sgml-state-reqs state))
511 (or (sgml-required-tokens (sgml-and-state-substate state)) 500 (or (sgml-required-tokens (sgml-and-state-substate state))
512 (loop for s in (sgml-and-state-dfas state) 501 (loop for s in (sgml-and-state-dfas state)
513 nconc (sgml-tokens-of-moves (sgml-state-reqs s))) 502 nconc (sgml-tokens-of-moves (sgml-state-reqs s)))
514 (sgml-tokens-of-moves (sgml-state-reqs (sgml-and-state-next state)))))) 503 (sgml-tokens-of-moves (sgml-state-reqs (sgml-and-state-next state))))))
504
505
506 (defsubst sgml-final (state)
507 (if (sgml-normal-state-p state)
508 (sgml-state-final-p state)
509 (sgml-final-and state)))
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))))
515 516
516 (defun sgml-optional-tokens (state) 517 (defun sgml-optional-tokens (state)
517 (if (sgml-normal-state-p state) 518 (if (sgml-normal-state-p state)
518 (sgml-tokens-of-moves (sgml-state-opts state)) 519 (sgml-tokens-of-moves (sgml-state-opts state))
519 (nconc 520 (nconc
1963 (sgml-trace-lookup "Start looking for %s entity %s public %s system %s" 1964 (sgml-trace-lookup "Start looking for %s entity %s public %s system %s"
1964 (or type "-") 1965 (or type "-")
1965 (or name "?") 1966 (or name "?")
1966 pubid 1967 pubid
1967 (sgml-extid-sysid extid)) 1968 (sgml-extid-sysid extid))
1968 (or (if (and sgml-system-identifiers-are-preferred 1969 (or (if sgml-system-identifiers-are-preferred
1969 (sgml-extid-sysid extid)) 1970 (sgml-lookup-sysid-as-file 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)))
1974 (sgml-catalog-lookup sgml-current-localcat pubid type name) 1971 (sgml-catalog-lookup sgml-current-localcat pubid type name)
1975 (sgml-catalog-lookup sgml-catalog-files pubid type name) 1972 (sgml-catalog-lookup sgml-catalog-files pubid type name)
1976 (if (not sgml-system-identifiers-are-preferred) 1973 (if (not sgml-system-identifiers-are-preferred)
1977 (sgml-lookup-sysid-as-file extid)) 1974 (sgml-lookup-sysid-as-file extid))
1978 (sgml-path-lookup extid type name)))) 1975 (sgml-path-lookup extid type name))))
3641 3638
3642 (defun sgml-modify-dtd (modifier) 3639 (defun sgml-modify-dtd (modifier)
3643 (setq sgml-dtd-info (sgml-pstate-dtd sgml-buffer-parse-state) 3640 (setq sgml-dtd-info (sgml-pstate-dtd sgml-buffer-parse-state)
3644 sgml-top-tree (sgml-pstate-top-tree sgml-buffer-parse-state)) 3641 sgml-top-tree (sgml-pstate-top-tree sgml-buffer-parse-state))
3645 (sgml-set-global) 3642 (sgml-set-global)
3646 (setq sgml-current-tree sgml-top-tree) 3643 ;;*** what is sgml-current-tree now?
3647 (while (stringp (cadr modifier)) ; Loop thru the context elements 3644 (while (stringp (cadr modifier)) ; Loop thru the context elements
3648 (let ((et (sgml-lookup-eltype (car modifier)))) 3645 (let ((et (sgml-lookup-eltype (car modifier))))
3649 (sgml-open-element et nil (point-min) (point-min)) 3646 (sgml-open-element et nil (point-min) (point-min))
3650 (setq modifier (cdr modifier)))) 3647 (setq modifier (cdr modifier))))
3651 3648