11:52 p.m.
|--==> "VB" == Vaclav Barta <vbar(a)comp.cz> writes:
VB> I've been re-formatting some HTML document (with
VB> indent-region-or-balanced-expression), and since it took forever (as
VB> usual:-( ), I changed my mind and pressed C-g. XEmacs normally
VB> responds well when I do that, but this time I got an internal error:
VB> (1) (file/alert) Cannot write backup file; backing up in ~/%backup%~
VB> (2) (error/warning) Error in post-gc-hook: (quit nil)
I wonder if the new GC algorithms would help here? What do you think,
Mike?
Vaclav, could you do a 'cvs up' and then build with '--use-kkcc' and
then see if you can reproduce the bug.
VB> Backtrace follows:
VB> # bind (inhibit-quit)
VB> # (unwind-protect ...)
VB> # (unwind-protect ...)
VB> # (catch #<INTERNAL OBJECT (XEmacs bug?) (opaque, size=0) 0x83cf610>
...)
VB> # (unwind-protect ...)
VB> # (unwind-protect ...)
VB> # bind (args)
VB> #<compiled-function (&rest args) "...(28)" [result args
reverse cons] 4 640435>((quote progn) (append (if move (\` ((forward-char (\, (length
ds)))))) (if (not (eq move (quote check))) (quote (t)))))
VB> (bq-list* (quote progn) (append (if move (\` ((forward-char (\, (length
ds)))))) (if (not (eq move (quote check))) (quote (t)))))
VB> (cons (bq-list* (quote progn) (append (if move (\` ((forward-char (\, (length
ds)))))) (if (not (eq move (quote check))) (quote (t))))) (if (eq move (quote check)) (\`
((sgml-delimiter-parse-error (\, delim))))))
VB> (cons (bq-list* (quote and) (append (loop for i from 0 below (length ds)
collect (\` (eq (\, (aref ds i)) (sgml-following-char (\, (+ i offset)))))) (list
(bq-list* (quote or) (loop for c in context collect (cond ((eq c (quote nmstart)) (\`
(sgml-startnm-char (or (sgml-following-char (\, (length ds))) 0)))) ((eq c (quote stagc))
(\` (and sgml-current-shorttag (sgml-is-delim "TAGC" nil nil (\, (length
ds)))))) ((eq c (quote digit)) (\` (memq (sgml-following-char (\, (length ds))) (quote (?0
?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))) ((stringp c) (\` (sgml-is-delim (\, c) nil nil (\, (length
ds))))) ((eq c t)) (t (error "Context type: %s" c)))))))) (cons (bq-list* (quote
progn) (append (if move (\` ((forward-char (\, (length ds)))))) (if (not (eq move (quote
check))) (quote (t))))) (if (eq move (quote check)) (\` ((sgml-delimiter-parse-error (\,
delim)))))))
VB> (cons (quote if) (cons (bq-list* (quote and) (append (loop for i from 0 below
(length ds) collect (\` (eq (\, (aref ds i)) (sgml-following-char (\, (+ i offset))))))
(list (bq-list* (quote or) (loop for c in context collect (cond ((eq c (quote nmstart))
(\` (sgml-startnm-char (or (sgml-following-char (\, (length ds))) 0)))) ((eq c (quote
stagc)) (\` (and sgml-current-shorttag (sgml-is-delim "TAGC" nil nil (\, (length
ds)))))) ((eq c (quote digit)) (\` (memq (sgml-following-char (\, (length ds))) (quote (?0
?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))) ((stringp c) (\` (sgml-is-delim (\, c) nil nil (\, (length
ds))))) ((eq c t)) (t (error "Context type: %s" c)))))))) (cons (bq-list* (quote
progn) (append (if move (\` ((forward-char (\, (length ds)))))) (if (not (eq move (quote
check))) (quote (t))))) (if (eq move (quote check)) (\` ((sgml-delimiter-parse-error (\,
delim))))))))
VB> (bq-list* (quote if) (bq-list* (quote and) (append (loop for i from 0 below
(length ds) collect (\` (eq (\, (aref ds i)) (sgml-following-char (\, (+ i offset))))))
(list (bq-list* (quote or) (loop for c in context collect (cond ((eq c (quote nmstart))
(\` (sgml-startnm-char (or (sgml-following-char (\, (length ds))) 0)))) ((eq c (quote
stagc)) (\` (and sgml-current-shorttag (sgml-is-delim "TAGC" nil nil (\, (length
ds)))))) ((eq c (quote digit)) (\` (memq (sgml-following-char (\, (length ds))) (quote (?0
?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))) ((stringp c) (\` (sgml-is-delim (\, c) nil nil (\, (length
ds))))) ((eq c t)) (t (error "Context type: %s" c)))))))) (bq-list* (quote
progn) (append (if move (\` ((forward-char (\, (length ds)))))) (if (not (eq move (quote
check))) (quote (t))))) (if (eq move (quote check)) (\` ((sgml-delimiter-parse-error (\,
delim))))))
VB> (\` (if (and (\,＠ (loop for i from 0 below (length ds) collect (\` (eq (\,
(aref ds i)) (sgml-following-char (\, (+ i offset))))))) (or (\,＠ (loop for c in context
collect (cond ((eq c (quote nmstart)) (\` (sgml-startnm-char (or (sgml-following-char (\,
(length ds))) 0)))) ((eq c (quote stagc)) (\` (and sgml-current-shorttag (sgml-is-delim
"TAGC" nil nil (\, (length ds)))))) ((eq c (quote digit)) (\` (memq
(sgml-following-char (\, (length ds))) (quote (?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))))
((stringp c) (\` (sgml-is-delim (\, c) nil nil (\, (length ds))))) ((eq c t)) (t (error
"Context type: %s" c))))))) (progn (\,＠ (if move (\` ((forward-char (\, (length
ds))))))) (\,＠ (if (not (eq move (quote check))) (quote (t))))) (\,＠ (if (eq move (quote
check)) (\` ((sgml-delimiter-parse-error (\, delim))))))))
VB> # bind (ds)
VB> (let ((ds (sgml-get-delim-string delim))) (assert ds) (cond ((eq context (quote
gi)) (setq context (quote (nmstart stagc)))) ((eq context (quote com)) (setq context
(quote ("COM" "MDC")))) ((null context) (setq context (quote (t))))
((not (listp context)) (setq context (list context)))) (\` (if (and (\,＠ (loop for i from
0 below (length ds) collect (\` (eq (\, (aref ds i)) (sgml-following-char (\, (+ i
offset))))))) (or (\,＠ (loop for c in context collect (cond ((eq c (quote nmstart)) (\`
(sgml-startnm-char (or (sgml-following-char (\, (length ds))) 0)))) ((eq c (quote stagc))
(\` (and sgml-current-shorttag (sgml-is-delim "TAGC" nil nil (\, (length
ds)))))) ((eq c (quote digit)) (\` (memq (sgml-following-char (\, (length ds))) (quote (?0
?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))) ((stringp c) (\` (sgml-is-delim (\, c) nil nil (\, (length
ds))))) ((eq c t)) (t (error "Context type: %s" c))))))) (progn (\,＠ (if move
(\` ((forward-char (\, (length ds))))))) (\,＠ (if (not (eq move (quote c!
VB> heck))) (quote (t))))) (\,＠ (if (eq move (quote check)) (\`
((sgml-delimiter-parse-error (\, delim)))))))))
VB> # bind (offset move context delim)
VB> (lambda (delim &optional context move offset) "Macro for matching
delimiters.\nSyntax: DELIM &optional CONTEXT MOVE\nwhere DELIM is the delimiter name
(string or symbol), \nCONTEXT the contextual constraint, and\nMOVE is `nil',
`move' or `check'.\n\nTest if the text following point in current buffer matches
the SGML\ndelimiter DELIM. Also check the characters after the delimiter for\nCONTEXT.
Applicable values for CONTEXT is \n`gi' -- name start or TAGC if SHORTTAG
YES,\n`com' -- if COM or MDC,\n`nmstart' -- name start character, \n`stagc' --
TAGC if SHORTTAG YES,\n`digit' -- any Digit,\nstring -- delimiter with that
name,\nlist -- any of the contextual constraints in the list." (or offset (setq
offset 0)) (setq delim (upcase (format "%s" delim))) (let ((ds
(sgml-get-delim-string delim))) (assert ds) (cond ((eq context (quote gi)) (setq context
(quote (nmstart stagc)))) ((eq context (quote com)) (setq context (quote ("COM"
"MDC")))) ((null context) (setq context (quote (t)!
VB> ))) ((not (listp context)) (setq context (list context)))) (\` (if (and (\,＠
(loop for i from 0 below (length ds) collect (\` (eq (\, (aref ds i)) (sgml-following-char
(\, (+ i offset))))))) (or (\,＠ (loop for c in context collect (cond ((eq c (quote
nmstart)) (\` (sgml-startnm-char (or (sgml-following-char (\, (length ds))) 0)))) ((eq c
(quote stagc)) (\` (and sgml-current-shorttag (sgml-is-delim "TAGC" nil nil (\,
(length ds)))))) ((eq c (quote digit)) (\` (memq (sgml-following-char (\, (length ds)))
(quote (?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))) ((stringp c) (\` (sgml-is-delim (\, c) nil nil
(\, (length ds))))) ((eq c t)) (t (error "Context type: %s" c))))))) (progn (\,＠
(if move (\` ((forward-char (\, (length ds))))))) (\,＠ (if (not (eq move (quote check)))
(quote (t))))) (\,＠ (if (eq move (quote check)) (\` ((sgml-delimiter-parse-error (\,
delim))))))))))("RNI" nil move)
VB> (sgml-is-delim "RNI" nil move)
VB> (sgml-parse-delim "RNI")
VB> (if (sgml-parse-delim "RNI") (sgml-check-token "DEFAULT"))
VB> (sgml-parse-rni "DEFAULT")
VB> (or (sgml-parse-rni "DEFAULT") (setq name (sgml-check-name t)))
VB> (cond ((sgml-parse-delim "PERO") (sgml-skip-ps) (setq name
(sgml-check-name t)) (setq dest (sgml-dtd-parameters sgml-dtd-info))) (t (or
(sgml-parse-rni "DEFAULT") (setq name (sgml-check-name t))) (setq dest
(sgml-dtd-entities sgml-dtd-info))))
VB> # bind (extid text notation type dest name)
VB> (let (name dest (type (quote text)) (notation nil) text extid) (cond
((sgml-parse-delim "PERO") (sgml-skip-ps) (setq name (sgml-check-name t)) (setq
dest (sgml-dtd-parameters sgml-dtd-info))) (t (or (sgml-parse-rni "DEFAULT")
(setq name (sgml-check-name t))) (setq dest (sgml-dtd-entities sgml-dtd-info))))
(sgml-skip-ps) (setq extid (sgml-parse-external)) (setq text (cond (extid (sgml-skip-ps)
(let ((tn (sgml-parse-entity-type))) (setq type (or (car tn) (quote text))) (unless (eq
(cdr tn) "") (setq notation (cdr tn)))) extid) ((sgml-startnm-char-next) (let
((token (intern (sgml-check-case (sgml-check-name))))) (sgml-skip-ps) (when (and
sgml-xml-p (memq token (quote (cdata sdata pi starttag endtag ms md)))) (sgml-error
"XML forbids %s entities." (upcase (symbol-name token)))) (cond ((memq token
(quote (CDATA SDATA))) (setq type token) (sgml-check-parameter-literal)) ((eq token (quote
PI)) (concat "<?" (sgml-check-parameter-literal) ">")) ((eq
token (quote STARTTAG)) (sgml-star!
VB> t-tag-of (sgml-check-parameter-literal))) ((eq token (quote ENDTAG))
(sgml-end-tag-of (sgml-check-parameter-literal))) ((eq token (quote MS)) (concat
"<![" (sgml-check-parameter-literal) "]]>")) ((eq token (quote
MD)) (concat "<!" (sgml-check-parameter-literal) ">")))))
((sgml-check-parameter-literal)))) (when dest (sgml-entity-declare name dest type text
notation)))
VB> sgml-declare-entity()
VB> funcall(sgml-declare-entity)
VB> (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut (sgml-skip-ps)
(funcall (cdr rut))) (t (sgml-parse-error "Illegal markup declaration %s"
tok)))
VB> # bind (rut tok)
VB> (let* ((tok (sgml-parse-nametoken)) (rut (assoc (sgml-check-case tok)
sgml-markup-declaration-table))) (when (and (not (memq option (quote (prolog ignore))))
(member tok (quote ("SGML" "DOCTYPE")))) (sgml-error "%s
declaration is only valid in prolog" tok)) (when (and (not (memq option (quote (dtd
ignore)))) (member tok (quote ("ELEMENT" "ENTITY" "ATTLIST"
"NOTATION" "SHORTREF")))) (sgml-error "%s declaration is only
valid in doctype" tok)) (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut
(sgml-skip-ps) (funcall (cdr rut))) (t (sgml-parse-error "Illegal markup declaration
%s" tok))))
VB> (cond ((sgml-startnm-char-next) (setq sgml-markup-type nil) (let* ((tok
(sgml-parse-nametoken)) (rut (assoc (sgml-check-case tok) sgml-markup-declaration-table)))
(when (and (not (memq option (quote (prolog ignore)))) (member tok (quote
("SGML" "DOCTYPE")))) (sgml-error "%s declaration is only valid
in prolog" tok)) (when (and (not (memq option (quote (dtd ignore)))) (member tok
(quote ("ELEMENT" "ENTITY" "ATTLIST" "NOTATION"
"SHORTREF")))) (sgml-error "%s declaration is only valid in doctype"
tok)) (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut (sgml-skip-ps) (funcall
(cdr rut))) (t (sgml-parse-error "Illegal markup declaration %s" tok))))) (t
(setq sgml-markup-type (quote comment))))
VB> (cond ((and sgml-xml-p (sgml-parse-xml-comment))) ((sgml-parse-delim
"MDO" (nmstart "COM" "MDC")) (cond ((sgml-startnm-char-next)
(setq sgml-markup-type nil) (let* ((tok (sgml-parse-nametoken)) (rut (assoc
(sgml-check-case tok) sgml-markup-declaration-table))) (when (and (not (memq option (quote
(prolog ignore)))) (member tok (quote ("SGML" "DOCTYPE"))))
(sgml-error "%s declaration is only valid in prolog" tok)) (when (and (not (memq
option (quote (dtd ignore)))) (member tok (quote ("ELEMENT" "ENTITY"
"ATTLIST" "NOTATION" "SHORTREF")))) (sgml-error "%s
declaration is only valid in doctype" tok)) (cond ((eq option (quote ignore))
(sgml-skip-upto-mdc)) (rut (sgml-skip-ps) (funcall (cdr rut))) (t (sgml-parse-error
"Illegal markup declaration %s" tok))))) (t (setq sgml-markup-type (quote
comment)))) (sgml-skip-ps) (sgml-check-delim "MDC") (unless (eq option (quote
ignore)) (when sgml-markup-type (sgml-set-markup-type sgml-markup-type))) t)
((sgml-parse-delim "MS-START") (sgml-do!
VB> -marked-section)))
VB> # bind (option)
VB> sgml-parse-markup-declaration(dtd)
VB> (cond ((and (eobp) (eq sgml-current-eref eref)) nil) ((sgml-parse-ds))
((sgml-parse-markup-declaration (quote dtd))) ((sgml-parse-delim "MS-END")))
VB> (progn (setq sgml-markup-start (point)) (cond ((and (eobp) (eq
sgml-current-eref eref)) nil) ((sgml-parse-ds)) ((sgml-parse-markup-declaration (quote
dtd))) ((sgml-parse-delim "MS-END"))))
VB> (while (progn (setq sgml-markup-start (point)) (cond ((and (eobp) (eq
sgml-current-eref eref)) nil) ((sgml-parse-ds)) ((sgml-parse-markup-declaration (quote
dtd))) ((sgml-parse-delim "MS-END")))))
VB> # bind (eref sgml-parsing-dtd)
VB> (let ((sgml-parsing-dtd t) (eref sgml-current-eref)) (while (progn (setq
sgml-markup-start (point)) (cond ((and (eobp) (eq sgml-current-eref eref)) nil)
((sgml-parse-ds)) ((sgml-parse-markup-declaration (quote dtd))) ((sgml-parse-delim
"MS-END"))))))
VB> sgml-check-dtd-subset()
VB> (cond (external (let ((decl (and (car external) (sgml-catalog-lookup
sgml-catalog-files nil (quote dtddecl) (sgml-canonize-pubid (car external)))))) (if decl
(setq sgml-declaration decl))) (sgml-push-to-entity (sgml-make-entity docname (quote dtd)
external)) (sgml-check-dtd-subset) (sgml-check-end-of-entity "DTD subset")
(sgml-pop-entity)))
VB> # bind (sgml-parsing-dtd)
VB> (let ((sgml-parsing-dtd t)) (setq sgml-no-elements 0) (setq sgml-dtd-info
(sgml-make-dtd docname)) (sgml-skip-ps) (cond ((sgml-parse-delim "DSO") (let
((original-buffer (current-buffer))) (sgml-check-dtd-subset) (if (eq (current-buffer)
original-buffer) (sgml-check-delim "DSC") (sgml-parse-error "Illegal
character '%c' in doctype declaration" (following-char)))))) (cond (external
(let ((decl (and (car external) (sgml-catalog-lookup sgml-catalog-files nil (quote
dtddecl) (sgml-canonize-pubid (car external)))))) (if decl (setq sgml-declaration decl)))
(sgml-push-to-entity (sgml-make-entity docname (quote dtd) external))
(sgml-check-dtd-subset) (sgml-check-end-of-entity "DTD subset")
(sgml-pop-entity))) (sgml-set-initial-state sgml-dtd-info) (run-hooks (quote
sgml-doctype-parsed-hook)))
VB> # bind (external docname)
VB> sgml-setup-doctype("HTML" ("-//W3C//DTD HTML 4.0
Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd" .
"/usr/local/apache/htdocs/german/bjokes/ar/"))
VB> # bind (sgml-markup-start)
VB> (let (sgml-markup-start) (message "Parsing doctype...")
(sgml-setup-doctype (sgml-check-name) (sgml-parse-external)) (message "Parsing
doctype...done"))
VB> (cond (sgml-dtd-info (sgml-skip-upto-mdc)) (t (let (sgml-markup-start) (message
"Parsing doctype...") (sgml-setup-doctype (sgml-check-name)
(sgml-parse-external)) (message "Parsing doctype...done"))))
VB> sgml-do-doctype()
VB> funcall(sgml-do-doctype)
VB> (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut (sgml-skip-ps)
(funcall (cdr rut))) (t (sgml-parse-error "Illegal markup declaration %s"
tok)))
VB> # bind (rut tok)
VB> (let* ((tok (sgml-parse-nametoken)) (rut (assoc (sgml-check-case tok)
sgml-markup-declaration-table))) (when (and (not (memq option (quote (prolog ignore))))
(member tok (quote ("SGML" "DOCTYPE")))) (sgml-error "%s
declaration is only valid in prolog" tok)) (when (and (not (memq option (quote (dtd
ignore)))) (member tok (quote ("ELEMENT" "ENTITY" "ATTLIST"
"NOTATION" "SHORTREF")))) (sgml-error "%s declaration is only
valid in doctype" tok)) (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut
(sgml-skip-ps) (funcall (cdr rut))) (t (sgml-parse-error "Illegal markup declaration
%s" tok))))
VB> (cond ((sgml-startnm-char-next) (setq sgml-markup-type nil) (let* ((tok
(sgml-parse-nametoken)) (rut (assoc (sgml-check-case tok) sgml-markup-declaration-table)))
(when (and (not (memq option (quote (prolog ignore)))) (member tok (quote
("SGML" "DOCTYPE")))) (sgml-error "%s declaration is only valid
in prolog" tok)) (when (and (not (memq option (quote (dtd ignore)))) (member tok
(quote ("ELEMENT" "ENTITY" "ATTLIST" "NOTATION"
"SHORTREF")))) (sgml-error "%s declaration is only valid in doctype"
tok)) (cond ((eq option (quote ignore)) (sgml-skip-upto-mdc)) (rut (sgml-skip-ps) (funcall
(cdr rut))) (t (sgml-parse-error "Illegal markup declaration %s" tok))))) (t
(setq sgml-markup-type (quote comment))))
VB> (cond ((and sgml-xml-p (sgml-parse-xml-comment))) ((sgml-parse-delim
"MDO" (nmstart "COM" "MDC")) (cond ((sgml-startnm-char-next)
(setq sgml-markup-type nil) (let* ((tok (sgml-parse-nametoken)) (rut (assoc
(sgml-check-case tok) sgml-markup-declaration-table))) (when (and (not (memq option (quote
(prolog ignore)))) (member tok (quote ("SGML" "DOCTYPE"))))
(sgml-error "%s declaration is only valid in prolog" tok)) (when (and (not (memq
option (quote (dtd ignore)))) (member tok (quote ("ELEMENT" "ENTITY"
"ATTLIST" "NOTATION" "SHORTREF")))) (sgml-error "%s
declaration is only valid in doctype" tok)) (cond ((eq option (quote ignore))
(sgml-skip-upto-mdc)) (rut (sgml-skip-ps) (funcall (cdr rut))) (t (sgml-parse-error
"Illegal markup declaration %s" tok))))) (t (setq sgml-markup-type (quote
comment)))) (sgml-skip-ps) (sgml-check-delim "MDC") (unless (eq option (quote
ignore)) (when sgml-markup-type (sgml-set-markup-type sgml-markup-type))) t)
((sgml-parse-delim "MS-START") (sgml-do!
VB> -marked-section)))
VB> # bind (option)
VB> sgml-parse-markup-declaration(prolog)
VB> (and (sgml-parse-markup-declaration (quote prolog)) (null sgml-dtd-info))
VB> (or (sgml-parse-s) (sgml-parse-processing-instruction) (and
(sgml-parse-markup-declaration (quote prolog)) (null sgml-dtd-info)))
VB> (progn (setq sgml-markup-start (point)) (or (sgml-parse-s)
(sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration (quote prolog))
(null sgml-dtd-info))))
VB> (while (progn (setq sgml-markup-start (point)) (or (sgml-parse-s)
(sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration (quote prolog))
(null sgml-dtd-info)))))
VB> (progn (while (progn (setq sgml-markup-start (point)) (or (sgml-parse-s)
(sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration (quote prolog))
(null sgml-dtd-info))))) (unless sgml-dtd-info (let ((docname (or
sgml-default-doctype-name (if (sgml-parse-delim "STAGO" gi)
(sgml-parse-name))))) (when docname (sgml-setup-doctype docname (quote (nil)))))))
VB> # (unwind-protect ...)
VB> (unwind-protect (progn (while (progn (setq sgml-markup-start (point)) (or
(sgml-parse-s) (sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration
(quote prolog)) (null sgml-dtd-info))))) (unless sgml-dtd-info (let ((docname (or
sgml-default-doctype-name (if (sgml-parse-delim "STAGO" gi)
(sgml-parse-name))))) (when docname (sgml-setup-doctype docname (quote (nil))))))) (setq
sgml-last-buffer (current-buffer)) (set-buffer cb) (set-syntax-table normal-syntax-table)
(set-buffer-modified-p buffer-modified) (sgml-debug "Restoring buffer mod: %s"
buffer-modified))
VB> # bind (buffer-modified cb normal-syntax-table)
VB> (let ((normal-syntax-table (syntax-table)) (cb (current-buffer))
(buffer-modified (buffer-modified-p))) (set-syntax-table (if sgml-xml-p xml-parser-syntax
sgml-parser-syntax)) (unwind-protect (progn (while (progn (setq sgml-markup-start (point))
(or (sgml-parse-s) (sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration
(quote prolog)) (null sgml-dtd-info))))) (unless sgml-dtd-info (let ((docname (or
sgml-default-doctype-name (if (sgml-parse-delim "STAGO" gi)
(sgml-parse-name))))) (when docname (sgml-setup-doctype docname (quote (nil))))))) (setq
sgml-last-buffer (current-buffer)) (set-buffer cb) (set-syntax-table normal-syntax-table)
(set-buffer-modified-p buffer-modified) (sgml-debug "Restoring buffer mod: %s"
buffer-modified)))
VB> (sgml-with-parser-syntax-ro (while (progn (setq sgml-markup-start (point)) (or
(sgml-parse-s) (sgml-parse-processing-instruction) (and (sgml-parse-markup-declaration
(quote prolog)) (null sgml-dtd-info))))) (unless sgml-dtd-info (let ((docname (or
sgml-default-doctype-name (if (sgml-parse-delim "STAGO" gi)
(sgml-parse-name))))) (when docname (sgml-setup-doctype docname (quote (nil)))))))
VB> sgml-parse-prolog()
VB> # (unwind-protect ...)
VB> (save-excursion (sgml-parse-prolog))
VB> (cond ((or sgml-parent-document sgml-doctype) (let ((dtd (save-excursion
(set-buffer (find-file-noselect (if (consp sgml-parent-document) (car
sgml-parent-document) (or sgml-doctype sgml-parent-document)))) (sgml-need-dtd)
(sgml-pstate-dtd sgml-buffer-parse-state)))) (sgml-set-initial-state dtd) (when (consp
sgml-parent-document) (sgml-modify-dtd (cdr sgml-parent-document))))) (t (save-excursion
(sgml-parse-prolog))))
VB> sgml-load-doctype()
VB> (if sgml-default-dtd-file (sgml-load-dtd sgml-default-dtd-file)
(sgml-load-doctype))
VB> (progn (add-hook (quote pre-command-hook) (quote sgml-reset-log))
(make-local-variable (quote sgml-auto-fill-inhibit-function)) (setq
sgml-auto-fill-inhibit-function (function sgml-in-prolog-p)) (if sgml-default-dtd-file
(sgml-load-dtd sgml-default-dtd-file) (sgml-load-doctype)))
VB> (if (null sgml-buffer-parse-state) (progn (add-hook (quote pre-command-hook)
(quote sgml-reset-log)) (make-local-variable (quote sgml-auto-fill-inhibit-function))
(setq sgml-auto-fill-inhibit-function (function sgml-in-prolog-p)) (if
sgml-default-dtd-file (sgml-load-dtd sgml-default-dtd-file) (sgml-load-doctype))))
VB> (when (null sgml-buffer-parse-state) (add-hook (quote pre-command-hook) (quote
sgml-reset-log)) (make-local-variable (quote sgml-auto-fill-inhibit-function)) (setq
sgml-auto-fill-inhibit-function (function sgml-in-prolog-p)) (if sgml-default-dtd-file
(sgml-load-dtd sgml-default-dtd-file) (sgml-load-doctype)))
VB> sgml-need-dtd()
VB> # bind (quiet extra-cond sgml-goal)
VB> sgml-parse-to(758)
VB> # (unwind-protect ...)
VB> (save-excursion (sgml-parse-to (1+ pos)) (let ((u sgml-top-tree)) (while (cond
((and (sgml-tree-next u) (>= pos (sgml-element-start (sgml-tree-next u)))) (setq u
(sgml-tree-next u))) ((and (sgml-tree-etag-epos u) (>= pos (sgml-tree-end u))) (setq u
(sgml-tree-parent u)) nil) ((and (sgml-tree-content u) (>= pos (sgml-element-start
(sgml-tree-content u)))) (setq u (sgml-tree-content u))))) u))
VB> # bind (pos)
VB> sgml-find-element-of(757)
VB> (if (eobp) (sgml-find-context-of (point)) (sgml-find-element-of (point)))
VB> # (catch parse-error ...)
VB> (catch sgml-throw-on-error (if (eobp) (sgml-find-context-of (point))
(sgml-find-element-of (point))))
VB> # bind (sgml-throw-on-error)
VB> (let ((sgml-throw-on-error (quote parse-error))) (catch sgml-throw-on-error (if
(eobp) (sgml-find-context-of (point)) (sgml-find-element-of (point)))))
VB> (setq element (let ((sgml-throw-on-error (quote parse-error))) (catch
sgml-throw-on-error (if (eobp) (sgml-find-context-of (point)) (sgml-find-element-of
(point))))))
VB> (if (or col element) nil (setq element (let ((sgml-throw-on-error (quote
parse-error))) (catch sgml-throw-on-error (if (eobp) (sgml-find-context-of (point))
(sgml-find-element-of (point)))))))
VB> (unless (or col element) (setq element (let ((sgml-throw-on-error (quote
parse-error))) (catch sgml-throw-on-error (if (eobp) (sgml-find-context-of (point))
(sgml-find-element-of (point)))))))
VB> # bind (here)
VB> (let ((here (point-marker))) (back-to-indentation) (unless (or col element)
(setq element (let ((sgml-throw-on-error (quote parse-error))) (catch sgml-throw-on-error
(if (eobp) (sgml-find-context-of (point)) (sgml-find-element-of (point))))))) (when (eq
element sgml-top-tree) (setq element nil) (goto-char here)) (when element
(sgml-with-parser-syntax (let ((stag (sgml-is-start-tag)) (etag (sgml-is-end-tag))) (cond
((and (> (point) (sgml-element-start element)) (< (point) (sgml-element-stag-end
element))) (setq col (+ (save-excursion (goto-char (sgml-element-start element))
(current-column)) (length (sgml-element-gi element)) 2))) ((and (not (member*
(sgml-element-gi (if (or stag etag) (sgml-element-parent element) element))
sgml-inhibit-indent-tags :test (function equalp))) (or sgml-indent-data (not
(sgml-element-data-p (if stag (sgml-element-parent element) element)))) (setq col (*
sgml-indent-step (+ (if (or stag etag) -1 0) (sgml-element-level element)))))))))) (when
(and!
VB> col (/= col (current-column))) (beginning-of-line 1) (delete-horizontal-space)
(indent-to col)) (when (< (point) here) (goto-char here)) col)
VB> (if sgml-indent-step (let ((here (point-marker))) (back-to-indentation) (unless
(or col element) (setq element (let ((sgml-throw-on-error (quote parse-error))) (catch
sgml-throw-on-error (if (eobp) (sgml-find-context-of (point)) (sgml-find-element-of
(point))))))) (when (eq element sgml-top-tree) (setq element nil) (goto-char here)) (when
element (sgml-with-parser-syntax (let ((stag (sgml-is-start-tag)) (etag
(sgml-is-end-tag))) (cond ((and (> (point) (sgml-element-start element)) (< (point)
(sgml-element-stag-end element))) (setq col (+ (save-excursion (goto-char
(sgml-element-start element)) (current-column)) (length (sgml-element-gi element)) 2)))
((and (not (member* (sgml-element-gi (if (or stag etag) (sgml-element-parent element)
element)) sgml-inhibit-indent-tags :test (function equalp))) (or sgml-indent-data (not
(sgml-element-data-p (if stag (sgml-element-parent element) element)))) (setq col (*
sgml-indent-step (+ (if (or stag etag) -1 0) (sgml-element-level element!
VB> )))))))))) (when (and col (/= col (current-column))) (beginning-of-line 1)
(delete-horizontal-space) (indent-to col)) (when (< (point) here) (goto-char here))
col))
VB> (when sgml-indent-step (let ((here (point-marker))) (back-to-indentation)
(unless (or col element) (setq element (let ((sgml-throw-on-error (quote parse-error)))
(catch sgml-throw-on-error (if (eobp) (sgml-find-context-of (point)) (sgml-find-element-of
(point))))))) (when (eq element sgml-top-tree) (setq element nil) (goto-char here)) (when
element (sgml-with-parser-syntax (let ((stag (sgml-is-start-tag)) (etag
(sgml-is-end-tag))) (cond ((and (> (point) (sgml-element-start element)) (< (point)
(sgml-element-stag-end element))) (setq col (+ (save-excursion (goto-char
(sgml-element-start element)) (current-column)) (length (sgml-element-gi element)) 2)))
((and (not (member* (sgml-element-gi (if (or stag etag) (sgml-element-parent element)
element)) sgml-inhibit-indent-tags :test (function equalp))) (or sgml-indent-data (not
(sgml-element-data-p (if stag (sgml-element-parent element) element)))) (setq col (*
sgml-indent-step (+ (if (or stag etag) -1 0) (sgml-element-level eleme!
VB> nt)))))))))) (when (and col (/= col (current-column))) (beginning-of-line 1)
(delete-horizontal-space) (indent-to col)) (when (< (point) here) (goto-char here))
col))
VB> # bind (element col)
VB> sgml-indent-line()
VB> funcall(sgml-indent-line)
VB> (if (null sgml-indent-step) (insert-tab) (funcall indent-line-function))
VB> (lambda nil "Indent line in proper way for current major mode."
(interactive) (if (null sgml-indent-step) (insert-tab) (funcall indent-line-function)))()
VB> call-interactively(sgml-indent-or-tab)
VB> # (condition-case ... . error)
VB> # (catch top-level ...)
--
|---<Steve Youngs>---------------<GnuPG KeyID: 10D5C9C5>---|
| XEmacs - It's not just an editor. |
| It's a way of life. |
|------------------------------------<youngs(a)xemacs.org>---|