[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r114557: * lisp/nxml/nxml-mode.el: Use lexical-bindi
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] trunk r114557: * lisp/nxml/nxml-mode.el: Use lexical-binding and syntax-propertize. |
|
Date: |
Mon, 07 Oct 2013 13:55:16 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 114557
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2013-10-07 09:54:48 -0400
message:
* lisp/nxml/nxml-mode.el: Use lexical-binding and syntax-propertize.
(font-lock-beg, font-lock-end): Move before first use.
(nxml-mode): Use syntax-propertize-function.
(nxml-after-change, nxml-after-change1): Adjust accordingly.
(nxml-extend-after-change-region): Remove.
* lisp/nxml/nxml-ns.el: Use lexical-binding.
(nxml-ns-save): Use `declare'.
(nxml-ns-prefixes-for): Avoid add-to-list.
* lisp/nxml/nxml-util.el: Use lexical-binding.
(nxml-with-degradation-on-error, nxml-with-invisible-motion):
Use `declare'.
* lisp/nxml/rng-match.el: Use lexical-binding.
(rng--ipattern): Use cl-defstruct.
(rng-compute-start-tag-open-deriv, rng-compute-start-attribute-deriv)
(rng-cons-group-after, rng-subst-group-after)
(rng-subst-interleave-after, rng-apply-after, rng-compute-data-deriv):
Use closures instead of `(lambda...).
* lisp/nxml/xmltok.el: Use lexical-binding.
(xmltok-save): Use `declare'.
(xmltok-unclosed-reparse-p, xmltok-semi-closed-reparse-p): Remove.
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/nxml/nxml-mode.el
nxmlmode.el-20091113204419-o5vbwnq5f7feedwu-7813
lisp/nxml/nxml-ns.el nxmlns.el-20091113204419-o5vbwnq5f7feedwu-7814
lisp/nxml/nxml-util.el
nxmlutil.el-20091113204419-o5vbwnq5f7feedwu-7819
lisp/nxml/rng-match.el
rngmatch.el-20091113204419-o5vbwnq5f7feedwu-7825
lisp/nxml/xmltok.el xmltok.el-20091113204419-o5vbwnq5f7feedwu-7836
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-10-07 12:45:20 +0000
+++ b/lisp/ChangeLog 2013-10-07 13:54:48 +0000
@@ -1,14 +1,37 @@
+2013-10-07 Stefan Monnier <address@hidden>
+
+ * nxml/nxml-mode.el: Use lexical-binding and syntax-propertize.
+ (font-lock-beg, font-lock-end): Move before first use.
+ (nxml-mode): Use syntax-propertize-function.
+ (nxml-after-change, nxml-after-change1): Adjust accordingly.
+ (nxml-extend-after-change-region): Remove.
+ * nxml/xmltok.el: Use lexical-binding.
+ (xmltok-save): Use `declare'.
+ (xmltok-unclosed-reparse-p, xmltok-semi-closed-reparse-p): Remove.
+ * nxml/nxml-util.el: Use lexical-binding.
+ (nxml-with-degradation-on-error, nxml-with-invisible-motion):
+ Use `declare'.
+ * nxml/nxml-ns.el: Use lexical-binding.
+ (nxml-ns-save): Use `declare'.
+ (nxml-ns-prefixes-for): Avoid add-to-list.
+ * nxml/rng-match.el: Use lexical-binding.
+ (rng--ipattern): Use cl-defstruct.
+ (rng-compute-start-tag-open-deriv, rng-compute-start-attribute-deriv)
+ (rng-cons-group-after, rng-subst-group-after)
+ (rng-subst-interleave-after, rng-apply-after, rng-compute-data-deriv):
+ Use closures instead of `(lambda...).
+
2013-10-07 Michael Albinus <address@hidden>
* net/tramp.el (tramp-handle-insert-file-contents): Improve handling
of BEG and END.
- * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use
- `tramp-handle-insert-file-contents'.
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ Use `tramp-handle-insert-file-contents'.
(tramp-gvfs-handle-insert-file-contents): Remove function.
- * net/tramp-sh.el (tramp-sh-handle-insert-directory): Use
- `save-restriction' in order to keep markers.
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory):
+ Use `save-restriction' in order to keep markers.
* net/trampver.el: Update release number.
@@ -20,7 +43,8 @@
* emacs-lisp/easymenu.el (easy-menu-create-menu): Use closures.
- * emacs-lisp/lisp-mode.el (eval-defun-2): Simplify, using
lexical-binding.
+ * emacs-lisp/lisp-mode.el (eval-defun-2): Simplify, using
+ lexical-binding.
* emacs-lisp/tq.el (tq-create): Use a closure instead of `(lambda...).
=== modified file 'lisp/nxml/nxml-mode.el'
--- a/lisp/nxml/nxml-mode.el 2013-05-15 18:31:51 +0000
+++ b/lisp/nxml/nxml-mode.el 2013-10-07 13:54:48 +0000
@@ -1,4 +1,4 @@
-;;; nxml-mode.el --- a new XML mode
+;;; nxml-mode.el --- a new XML mode -*- lexical-binding:t -*-
;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc.
@@ -540,14 +540,14 @@
(nxml-scan-prolog)))))
(add-hook 'completion-at-point-functions
#'nxml-completion-at-point-function nil t)
- (add-hook 'after-change-functions 'nxml-after-change nil t)
+ (setq-local syntax-propertize-function #'nxml-after-change)
(add-hook 'change-major-mode-hook 'nxml-cleanup nil t)
;; Emacs 23 handles the encoding attribute on the xml declaration
;; transparently to nxml-mode, so there is no longer a need for the below
;; hook. The hook also had the drawback of overriding explicit user
;; instruction to save as some encoding other than utf-8.
-;;; (add-hook 'write-contents-hooks 'nxml-prepare-to-save)
+ ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
@@ -561,8 +561,6 @@
nil ; font-lock-keywords-case-fold-search. XML is case sensitive
nil ; no special syntax table
nil ; no automatic syntactic fontification
- (font-lock-extend-after-change-region-function
- . nxml-extend-after-change-region)
(font-lock-extend-region-functions . (nxml-extend-region))
(jit-lock-contextually . t)
(font-lock-unfontify-region-function . nxml-unfontify-region)))
@@ -597,6 +595,7 @@
;;; Change management
+(defvar font-lock-beg) (defvar font-lock-end)
(defun nxml-debug-region (start end)
(interactive "r")
(let ((font-lock-beg start)
@@ -605,22 +604,16 @@
(goto-char font-lock-beg)
(set-mark font-lock-end)))
-(defun nxml-after-change (start end pre-change-length)
- ; In font-lock mode, nxml-after-change1 is called via
- ; nxml-extend-after-change-region instead so that the updated
- ; book-keeping information is available for fontification.
- (unless (or font-lock-mode nxml-degraded)
+(defun nxml-after-change (start end)
+ ;; Called via syntax-propertize-function.
+ (unless nxml-degraded
(nxml-with-degradation-on-error 'nxml-after-change
- (save-excursion
- (save-restriction
- (widen)
- (save-match-data
- (nxml-with-invisible-motion
- (with-silent-modifications
- (nxml-after-change1
- start end pre-change-length)))))))))
+ (save-restriction
+ (widen)
+ (nxml-with-invisible-motion
+ (nxml-after-change1 start end))))))
-(defun nxml-after-change1 (start end pre-change-length)
+(defun nxml-after-change1 (start end)
"After-change bookkeeping.
Returns a cons cell containing a possibly-enlarged change region.
You must call `nxml-extend-region' on this expanded region to obtain
@@ -628,23 +621,14 @@
For bookkeeping, call this function even when fontification is
disabled."
- (let ((pre-change-end (+ start pre-change-length)))
- ;; If the prolog might have changed, rescan the prolog
- (when (<= start
- ;; Add 2 so as to include the < and following char that
- ;; start the instance (document element), since changing
- ;; these can change where the prolog ends.
- (+ nxml-prolog-end 2))
- ;; end must be extended to at least the end of the old prolog in
- ;; case the new prolog is shorter
- (when (< pre-change-end nxml-prolog-end)
- (setq end
- ;; don't let end get out of range even if pre-change-length
- ;; is bogus
- (min (point-max)
- (+ end (- nxml-prolog-end pre-change-end)))))
- (nxml-scan-prolog)
- (setq start (point-min))))
+ ;; If the prolog might have changed, rescan the prolog.
+ (when (<= start
+ ;; Add 2 so as to include the < and following char that
+ ;; start the instance (document element), since changing
+ ;; these can change where the prolog ends.
+ (+ nxml-prolog-end 2))
+ (nxml-scan-prolog)
+ (setq start (point-min)))
(when (> end nxml-prolog-end)
(goto-char start)
@@ -653,8 +637,7 @@
(setq end (max (nxml-scan-after-change start end)
end)))
- (nxml-debug-change "nxml-after-change1" start end)
- (cons start end))
+ (nxml-debug-change "nxml-after-change1" start end))
;;; Encodings
@@ -845,7 +828,6 @@
(font-lock-default-unfontify-region start end)
(nxml-clear-char-ref-extra-display start end))
-(defvar font-lock-beg) (defvar font-lock-end)
(defun nxml-extend-region ()
"Extend the region to hold the minimum area we can fontify with nXML.
Called with `font-lock-beg' and `font-lock-end' dynamically bound."
@@ -887,19 +869,6 @@
(nxml-debug-change "nxml-extend-region" start end)
t)))
-(defun nxml-extend-after-change-region (start end pre-change-length)
- (unless nxml-degraded
- (nxml-with-degradation-on-error
- 'nxml-extend-after-change-region
- (save-excursion
- (save-restriction
- (widen)
- (save-match-data
- (nxml-with-invisible-motion
- (with-silent-modifications
- (nxml-after-change1
- start end pre-change-length)))))))))
-
(defun nxml-fontify-matcher (bound)
"Called as font-lock keyword matcher."
=== modified file 'lisp/nxml/nxml-ns.el'
--- a/lisp/nxml/nxml-ns.el 2013-01-01 09:11:05 +0000
+++ b/lisp/nxml/nxml-ns.el 2013-10-07 13:54:48 +0000
@@ -1,4 +1,4 @@
-;;; nxml-ns.el --- XML namespace processing
+;;; nxml-ns.el --- XML namespace processing -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
@@ -56,12 +56,10 @@
(equal nxml-ns-state state))
(defmacro nxml-ns-save (&rest body)
+ (declare (indent 0) (debug t))
`(let ((nxml-ns-state nxml-ns-initial-state))
,@body))
-(put 'nxml-ns-save 'lisp-indent-function 0)
-(def-edebug-spec nxml-ns-save t)
-
(defun nxml-ns-init ()
(setq nxml-ns-state nxml-ns-initial-state))
@@ -117,11 +115,12 @@
(setq current (cdr current))
(while (let ((binding (rassq ns current)))
(when binding
- (when (eq (nxml-ns-get-prefix (car binding)) ns)
- (add-to-list 'prefixes
- (car binding)))
- (setq current
- (cdr (member binding current))))))
+ (let ((prefix (car binding)))
+ (when (eq (nxml-ns-get-prefix prefix) ns)
+ (unless (member prefix prefixes)
+ (push prefix prefixes))))
+ (setq current
+ (cdr (member binding current))))))
prefixes))
(defun nxml-ns-prefix-for (ns)
=== modified file 'lisp/nxml/nxml-util.el'
--- a/lisp/nxml/nxml-util.el 2013-08-29 01:20:05 +0000
+++ b/lisp/nxml/nxml-util.el 2013-10-07 13:54:48 +0000
@@ -1,4 +1,4 @@
-;;; nxml-util.el --- utility functions for nxml-*.el
+;;; nxml-util.el --- utility functions for nxml-*.el -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
@@ -70,6 +70,7 @@
(nxml-make-namespace "http://www.w3.org/2000/xmlns/";))
(defmacro nxml-with-degradation-on-error (context &rest body)
+ (declare (indent 1) (debug t))
(if (not nxml-debug)
(let ((error-symbol (make-symbol "err")))
`(condition-case ,error-symbol
@@ -80,12 +81,10 @@
(defmacro nxml-with-invisible-motion (&rest body)
"Evaluate body without calling any point motion hooks."
+ (declare (indent 0) (debug t))
`(let ((inhibit-point-motion-hooks t))
,@body))
-(put 'nxml-with-invisible-motion 'lisp-indent-function 0)
-(def-edebug-spec nxml-with-invisible-motion t)
-
(defun nxml-display-file-parse-error (err)
(let* ((filename (nth 1 err))
(buffer (find-file-noselect filename))
=== modified file 'lisp/nxml/rng-match.el'
--- a/lisp/nxml/rng-match.el 2013-08-09 21:22:44 +0000
+++ b/lisp/nxml/rng-match.el 2013-10-07 13:54:48 +0000
@@ -1,4 +1,4 @@
-;;; rng-match.el --- matching of RELAX NG patterns against XML events
+;;; rng-match.el --- matching of RELAX NG patterns against XML events -*-
lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
@@ -34,6 +34,7 @@
(require 'rng-pttrn)
(require 'rng-util)
(require 'rng-dt)
+(eval-when-compile (require 'cl-lib))
(defvar rng-not-allowed-ipattern nil)
(defvar rng-empty-ipattern nil)
@@ -63,38 +64,31 @@
;;; Interned patterns
-(eval-when-compile
- (defun rng-ipattern-slot-accessor-name (slot-name)
- (intern (concat "rng-ipattern-get-"
- (symbol-name slot-name))))
-
- (defun rng-ipattern-slot-setter-name (slot-name)
- (intern (concat "rng-ipattern-set-"
- (symbol-name slot-name)))))
-
-(defmacro rng-ipattern-defslot (slot-name index)
- `(progn
- (defsubst ,(rng-ipattern-slot-accessor-name slot-name) (ipattern)
- (aref ipattern ,index))
- (defsubst ,(rng-ipattern-slot-setter-name slot-name) (ipattern value)
- (aset ipattern ,index value))))
-
-(rng-ipattern-defslot type 0)
-(rng-ipattern-defslot index 1)
-(rng-ipattern-defslot name-class 2)
-(rng-ipattern-defslot datatype 2)
-(rng-ipattern-defslot after 2)
-(rng-ipattern-defslot child 3)
-(rng-ipattern-defslot value-object 3)
-(rng-ipattern-defslot nullable 4)
-(rng-ipattern-defslot memo-text-typed 5)
-(rng-ipattern-defslot memo-map-start-tag-open-deriv 6)
-(rng-ipattern-defslot memo-map-start-attribute-deriv 7)
-(rng-ipattern-defslot memo-start-tag-close-deriv 8)
-(rng-ipattern-defslot memo-text-only-deriv 9)
-(rng-ipattern-defslot memo-mixed-text-deriv 10)
-(rng-ipattern-defslot memo-map-data-deriv 11)
-(rng-ipattern-defslot memo-end-tag-deriv 12)
+(cl-defstruct (rng--ipattern
+ (:constructor nil)
+ (:type vector)
+ (:copier nil)
+ (:constructor rng-make-ipattern
+ (type index name-class child nullable)))
+ type
+ index
+ name-class ;; Field also known as: `datatype' and `after'.
+ child ;; Field also known as: `value-object'.
+ nullable
+ (memo-text-typed 'unknown)
+ memo-map-start-tag-open-deriv
+ memo-map-start-attribute-deriv
+ memo-start-tag-close-deriv
+ memo-text-only-deriv
+ memo-mixed-text-deriv
+ memo-map-data-deriv
+ memo-end-tag-deriv)
+
+;; I think depending on the value of `type' the two fields after `index'
+;; are used sometimes for different purposes, hence the aliases here:
+(defalias 'rng--ipattern-datatype 'rng--ipattern-name-class)
+(defalias 'rng--ipattern-after 'rng--ipattern-name-class)
+(defalias 'rng--ipattern-value-object 'rng--ipattern-child)
(defconst rng-memo-map-alist-max 10)
@@ -142,25 +136,6 @@
(cons (cons key value)
(cdr mm))))))))
-(defsubst rng-make-ipattern (type index name-class child nullable)
- (vector type index name-class child nullable
- ;; 5 memo-text-typed
- 'unknown
- ;; 6 memo-map-start-tag-open-deriv
- nil
- ;; 7 memo-map-start-attribute-deriv
- nil
- ;; 8 memo-start-tag-close-deriv
- nil
- ;; 9 memo-text-only-deriv
- nil
- ;; 10 memo-mixed-text-deriv
- nil
- ;; 11 memo-map-data-deriv
- nil
- ;; 12 memo-end-tag-deriv
- nil))
-
(defun rng-ipattern-maybe-init ()
(unless rng-ipattern-table
(setq rng-ipattern-table (make-hash-table :test 'equal))
@@ -208,8 +183,8 @@
(if (eq child rng-not-allowed-ipattern)
rng-not-allowed-ipattern
(let ((key (list 'after
- (rng-ipattern-get-index child)
- (rng-ipattern-get-index after))))
+ (rng--ipattern-index child)
+ (rng--ipattern-index after))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'after
@@ -222,7 +197,7 @@
rng-not-allowed-ipattern
(let ((key (list 'attribute
name-class
- (rng-ipattern-get-index ipattern))))
+ (rng--ipattern-index ipattern))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'attribute
@@ -238,8 +213,8 @@
dt
nil
matches-anything)))
- (rng-ipattern-set-memo-text-typed ipattern
- (not matches-anything))
+ (setf (rng--ipattern-memo-text-typed ipattern)
+ (not matches-anything))
ipattern))))
(defun rng-intern-data-except (dt ipattern)
@@ -263,20 +238,20 @@
(defun rng-intern-one-or-more (ipattern)
(or (rng-intern-one-or-more-shortcut ipattern)
(let ((key (cons 'one-or-more
- (list (rng-ipattern-get-index ipattern)))))
+ (list (rng--ipattern-index ipattern)))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'one-or-more
nil
ipattern
- (rng-ipattern-get-nullable ipattern))))))
+ (rng--ipattern-nullable ipattern))))))
(defun rng-intern-one-or-more-shortcut (ipattern)
(cond ((eq ipattern rng-not-allowed-ipattern)
rng-not-allowed-ipattern)
((eq ipattern rng-empty-ipattern)
rng-empty-ipattern)
- ((eq (rng-ipattern-get-type ipattern) 'one-or-more)
+ ((eq (rng--ipattern-type ipattern) 'one-or-more)
ipattern)
(t nil)))
@@ -284,7 +259,7 @@
(if (eq ipattern rng-not-allowed-ipattern)
rng-not-allowed-ipattern
(let ((key (cons 'list
- (list (rng-ipattern-get-index ipattern)))))
+ (list (rng--ipattern-index ipattern)))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'list
@@ -299,7 +274,7 @@
(normalized (cdr tem)))
(or (rng-intern-group-shortcut normalized)
(let ((key (cons 'group
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'group
@@ -345,10 +320,10 @@
(setq member (car ipatterns))
(setq ipatterns (cdr ipatterns))
(when nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'group)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'group)
(setq result
- (nconc (reverse (rng-ipattern-get-child member))
+ (nconc (reverse (rng--ipattern-child member))
result)))
((eq member rng-not-allowed-ipattern)
(setq result (list rng-not-allowed-ipattern))
@@ -363,7 +338,7 @@
(normalized (cdr tem)))
(or (rng-intern-group-shortcut normalized)
(let ((key (cons 'interleave
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'interleave
@@ -383,10 +358,10 @@
(setq member (car ipatterns))
(setq ipatterns (cdr ipatterns))
(when nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'interleave)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'interleave)
(setq result
- (append (rng-ipattern-get-child member)
+ (append (rng--ipattern-child member)
result)))
((eq member rng-not-allowed-ipattern)
(setq result (list rng-not-allowed-ipattern))
@@ -407,7 +382,7 @@
(rng-intern-choice1 normalized (car tem))))))
(defun rng-intern-optional (ipattern)
- (cond ((rng-ipattern-get-nullable ipattern) ipattern)
+ (cond ((rng--ipattern-nullable ipattern) ipattern)
((eq ipattern rng-not-allowed-ipattern) rng-empty-ipattern)
(t (rng-intern-choice1
;; This is sorted since the empty pattern
@@ -415,15 +390,15 @@
;; It cannot have a duplicate empty pattern,
;; since it is not nullable.
(cons rng-empty-ipattern
- (if (eq (rng-ipattern-get-type ipattern) 'choice)
- (rng-ipattern-get-child ipattern)
+ (if (eq (rng--ipattern-type ipattern) 'choice)
+ (rng--ipattern-child ipattern)
(list ipattern)))
t))))
(defun rng-intern-choice1 (normalized nullable)
(let ((key (cons 'choice
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'choice
@@ -466,10 +441,10 @@
(while cur
(setq member (car cur))
(or nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'choice)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'choice)
(setq final-tail
- (append (rng-ipattern-get-child member)
+ (append (rng--ipattern-child member)
final-tail))
(setq cur (cdr cur))
(setq sorted nil)
@@ -479,7 +454,7 @@
(setcdr tail cur))
(t
(if (and sorted
- (let ((cur-index (rng-ipattern-get-index member)))
+ (let ((cur-index (rng--ipattern-index member)))
(if (>= prev-index cur-index)
(or (= prev-index cur-index) ; will remove it
(setq sorted nil)) ; won't remove it
@@ -501,8 +476,8 @@
(rng-uniquify-eq (sort head 'rng-compare-ipattern))))))
(defun rng-compare-ipattern (p1 p2)
- (< (rng-ipattern-get-index p1)
- (rng-ipattern-get-index p2)))
+ (< (rng--ipattern-index p1)
+ (rng--ipattern-index p2)))
;;; Name classes
@@ -557,50 +532,50 @@
;;; Debugging utilities
(defun rng-ipattern-to-string (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(concat (rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
" </> "
(rng-ipattern-to-string
- (rng-ipattern-get-after ipattern))))
+ (rng--ipattern-after ipattern))))
((eq type 'element)
(concat "element "
(rng-name-class-to-string
- (rng-ipattern-get-name-class ipattern))
+ (rng--ipattern-name-class ipattern))
;; we can get cycles with elements so don't print it out
" {...}"))
((eq type 'attribute)
(concat "attribute "
(rng-name-class-to-string
- (rng-ipattern-get-name-class ipattern))
+ (rng--ipattern-name-class ipattern))
" { "
(rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
" } "))
((eq type 'empty) "empty")
((eq type 'text) "text")
((eq type 'not-allowed) "notAllowed")
((eq type 'one-or-more)
(concat (rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
"+"))
((eq type 'choice)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
" | ")
")"))
((eq type 'group)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
", ")
")"))
((eq type 'interleave)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
" & ")
")"))
(t (symbol-name type)))))
@@ -664,10 +639,10 @@
nil))
(defun rng-element-get-child (element)
- (let ((tem (rng-ipattern-get-child element)))
+ (let ((tem (rng--ipattern-child element)))
(if (vectorp tem)
tem
- (rng-ipattern-set-child element (rng-compile tem)))))
+ (setf (rng--ipattern-child element) (rng-compile tem)))))
(defun rng-compile-attribute (name-class pattern)
(rng-intern-attribute (rng-compile-name-class name-class)
@@ -839,17 +814,16 @@
;;; Derivatives
(defun rng-ipattern-text-typed-p (ipattern)
- (let ((memo (rng-ipattern-get-memo-text-typed ipattern)))
+ (let ((memo (rng--ipattern-memo-text-typed ipattern)))
(if (eq memo 'unknown)
- (rng-ipattern-set-memo-text-typed
- ipattern
- (rng-ipattern-compute-text-typed-p ipattern))
+ (setf (rng--ipattern-memo-text-typed ipattern)
+ (rng-ipattern-compute-text-typed-p ipattern))
memo)))
(defun rng-ipattern-compute-text-typed-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (let ((cur (rng-ipattern-get-child ipattern))
+ (let ((cur (rng--ipattern-child ipattern))
(ret nil))
(while (and cur (not ret))
(if (rng-ipattern-text-typed-p (car cur))
@@ -857,7 +831,7 @@
(setq cur (cdr cur))))
ret))
((eq type 'group)
- (let ((cur (rng-ipattern-get-child ipattern))
+ (let ((cur (rng--ipattern-child ipattern))
(ret nil)
member)
(while (and cur (not ret))
@@ -865,17 +839,17 @@
(if (rng-ipattern-text-typed-p member)
(setq ret t))
(setq cur
- (and (rng-ipattern-get-nullable member)
+ (and (rng--ipattern-nullable member)
(cdr cur))))
ret))
((eq type 'after)
- (rng-ipattern-text-typed-p (rng-ipattern-get-child ipattern)))
+ (rng-ipattern-text-typed-p (rng--ipattern-child ipattern)))
(t (and (memq type '(value list data data-except)) t)))))
(defun rng-start-tag-open-deriv (ipattern nm)
(or (rng-memo-map-get
nm
- (rng-ipattern-get-memo-map-start-tag-open-deriv ipattern))
+ (rng--ipattern-memo-map-start-tag-open-deriv ipattern))
(rng-ipattern-memo-start-tag-open-deriv
ipattern
nm
@@ -883,56 +857,54 @@
(defun rng-ipattern-memo-start-tag-open-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
- (rng-ipattern-set-memo-map-start-tag-open-deriv
- ipattern
- (rng-memo-map-add nm
- deriv
- (rng-ipattern-get-memo-map-start-tag-open-deriv
- ipattern))))
+ (setf (rng--ipattern-memo-map-start-tag-open-deriv ipattern)
+ (rng-memo-map-add nm
+ deriv
+ (rng--ipattern-memo-map-start-tag-open-deriv
+ ipattern))))
deriv)
(defun rng-compute-start-tag-open-deriv (ipattern nm)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (rng-transform-choice `(lambda (p)
- (rng-start-tag-open-deriv p ',nm))
+ (rng-transform-choice (lambda (p)
+ (rng-start-tag-open-deriv p nm))
ipattern))
((eq type 'element)
(if (rng-name-class-contains
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
nm)
(rng-intern-after (rng-element-get-child ipattern)
rng-empty-ipattern)
rng-not-allowed-ipattern))
((eq type 'group)
(rng-transform-group-nullable
- `(lambda (p) (rng-start-tag-open-deriv p ',nm))
+ (lambda (p) (rng-start-tag-open-deriv p nm))
'rng-cons-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-tag-open-deriv p ',nm))
+ (lambda (p) (rng-start-tag-open-deriv p nm))
'rng-subst-interleave-after
ipattern))
((eq type 'one-or-more)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-group (list p ,(rng-intern-optional ipattern))))
- (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((ip (rng-intern-optional ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-group (list p ip)))
+ (rng-start-tag-open-deriv (rng--ipattern-child ipattern)
+ nm))))
((eq type 'after)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-after p
- ,(rng-ipattern-get-after ipattern)))
- (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((nip (rng--ipattern-after ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-after p nip))
+ (rng-start-tag-open-deriv (rng--ipattern-child ipattern)
+ nm))))
(t rng-not-allowed-ipattern))))
(defun rng-start-attribute-deriv (ipattern nm)
(or (rng-memo-map-get
nm
- (rng-ipattern-get-memo-map-start-attribute-deriv ipattern))
+ (rng--ipattern-memo-map-start-attribute-deriv ipattern))
(rng-ipattern-memo-start-attribute-deriv
ipattern
nm
@@ -940,82 +912,79 @@
(defun rng-ipattern-memo-start-attribute-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
- (rng-ipattern-set-memo-map-start-attribute-deriv
- ipattern
- (rng-memo-map-add
- nm
- deriv
- (rng-ipattern-get-memo-map-start-attribute-deriv ipattern))))
+ (setf (rng--ipattern-memo-map-start-attribute-deriv ipattern)
+ (rng-memo-map-add
+ nm
+ deriv
+ (rng--ipattern-memo-map-start-attribute-deriv ipattern))))
deriv)
(defun rng-compute-start-attribute-deriv (ipattern nm)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (rng-transform-choice `(lambda (p)
- (rng-start-attribute-deriv p ',nm))
+ (rng-transform-choice (lambda (p)
+ (rng-start-attribute-deriv p nm))
ipattern))
((eq type 'attribute)
(if (rng-name-class-contains
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
nm)
- (rng-intern-after (rng-ipattern-get-child ipattern)
+ (rng-intern-after (rng--ipattern-child ipattern)
rng-empty-ipattern)
rng-not-allowed-ipattern))
((eq type 'group)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-attribute-deriv p ',nm))
+ (lambda (p) (rng-start-attribute-deriv p nm))
'rng-subst-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-attribute-deriv p ',nm))
+ (lambda (p) (rng-start-attribute-deriv p nm))
'rng-subst-interleave-after
ipattern))
((eq type 'one-or-more)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-group (list p ,(rng-intern-optional ipattern))))
- (rng-start-attribute-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((ip (rng-intern-optional ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-group (list p ip)))
+ (rng-start-attribute-deriv (rng--ipattern-child ipattern)
+ nm))))
((eq type 'after)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-after p ,(rng-ipattern-get-after ipattern)))
- (rng-start-attribute-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((nip (rng--ipattern-after ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-after p nip))
+ (rng-start-attribute-deriv (rng--ipattern-child ipattern)
+ nm))))
(t rng-not-allowed-ipattern))))
(defun rng-cons-group-after (x y)
- (rng-apply-after `(lambda (p) (rng-intern-group (cons p ',y)))
+ (rng-apply-after (lambda (p) (rng-intern-group (cons p y)))
x))
(defun rng-subst-group-after (new old list)
- (rng-apply-after `(lambda (p)
- (rng-intern-group (rng-substq p ,old ',list)))
+ (rng-apply-after (lambda (p)
+ (rng-intern-group (rng-substq p old list)))
new))
(defun rng-subst-interleave-after (new old list)
- (rng-apply-after `(lambda (p)
- (rng-intern-interleave (rng-substq p ,old ',list)))
+ (rng-apply-after (lambda (p)
+ (rng-intern-interleave (rng-substq p old list)))
new))
(defun rng-apply-after (f ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(rng-intern-after
- (rng-ipattern-get-child ipattern)
- (funcall f
- (rng-ipattern-get-after ipattern))))
+ (rng--ipattern-child ipattern)
+ (funcall f (rng--ipattern-after ipattern))))
((eq type 'choice)
- (rng-transform-choice `(lambda (x) (rng-apply-after ,f x))
+ (rng-transform-choice (lambda (x) (rng-apply-after f x))
ipattern))
(t rng-not-allowed-ipattern))))
(defun rng-start-tag-close-deriv (ipattern)
- (or (rng-ipattern-get-memo-start-tag-close-deriv ipattern)
- (rng-ipattern-set-memo-start-tag-close-deriv
- ipattern
- (rng-compute-start-tag-close-deriv ipattern))))
+ (or (rng--ipattern-memo-start-tag-close-deriv ipattern)
+ (setf (rng--ipattern-memo-start-tag-close-deriv ipattern)
+ (rng-compute-start-tag-close-deriv ipattern))))
(defconst rng-transform-map
'((choice . rng-transform-choice)
@@ -1025,7 +994,7 @@
(after . rng-transform-after-child)))
(defun rng-compute-start-tag-close-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'attribute)
rng-not-allowed-ipattern
(let ((transform (assq type rng-transform-map)))
@@ -1036,7 +1005,7 @@
ipattern)))))
(defun rng-ignore-attributes-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'attribute)
rng-empty-ipattern
(let ((transform (assq type rng-transform-map)))
@@ -1047,13 +1016,12 @@
ipattern)))))
(defun rng-text-only-deriv (ipattern)
- (or (rng-ipattern-get-memo-text-only-deriv ipattern)
- (rng-ipattern-set-memo-text-only-deriv
- ipattern
- (rng-compute-text-only-deriv ipattern))))
+ (or (rng--ipattern-memo-text-only-deriv ipattern)
+ (setf (rng--ipattern-memo-text-only-deriv ipattern)
+ (rng-compute-text-only-deriv ipattern))))
(defun rng-compute-text-only-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'element)
rng-not-allowed-ipattern
(let ((transform (assq type
@@ -1069,13 +1037,12 @@
ipattern)))))
(defun rng-mixed-text-deriv (ipattern)
- (or (rng-ipattern-get-memo-mixed-text-deriv ipattern)
- (rng-ipattern-set-memo-mixed-text-deriv
- ipattern
- (rng-compute-mixed-text-deriv ipattern))))
+ (or (rng--ipattern-memo-mixed-text-deriv ipattern)
+ (setf (rng--ipattern-memo-mixed-text-deriv ipattern)
+ (rng-compute-mixed-text-deriv ipattern))))
(defun rng-compute-mixed-text-deriv (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'text) ipattern)
((eq type 'after)
(rng-transform-after-child 'rng-mixed-text-deriv
@@ -1086,7 +1053,7 @@
((eq type 'one-or-more)
(rng-intern-group
(list (rng-mixed-text-deriv
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
(rng-intern-optional ipattern))))
((eq type 'group)
(rng-transform-group-nullable
@@ -1100,39 +1067,38 @@
(rng-substq new old list)))
ipattern))
((and (eq type 'data)
- (not (rng-ipattern-get-memo-text-typed ipattern)))
+ (not (rng--ipattern-memo-text-typed ipattern)))
ipattern)
(t rng-not-allowed-ipattern))))
(defun rng-end-tag-deriv (ipattern)
- (or (rng-ipattern-get-memo-end-tag-deriv ipattern)
- (rng-ipattern-set-memo-end-tag-deriv
- ipattern
- (rng-compute-end-tag-deriv ipattern))))
+ (or (rng--ipattern-memo-end-tag-deriv ipattern)
+ (setf (rng--ipattern-memo-end-tag-deriv ipattern)
+ (rng-compute-end-tag-deriv ipattern))))
(defun rng-compute-end-tag-deriv (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
(rng-intern-choice
(mapcar 'rng-end-tag-deriv
- (rng-ipattern-get-child ipattern))))
+ (rng--ipattern-child ipattern))))
((eq type 'after)
- (if (rng-ipattern-get-nullable
- (rng-ipattern-get-child ipattern))
- (rng-ipattern-get-after ipattern)
+ (if (rng--ipattern-nullable
+ (rng--ipattern-child ipattern))
+ (rng--ipattern-after ipattern)
rng-not-allowed-ipattern))
(t rng-not-allowed-ipattern))))
(defun rng-data-deriv (ipattern value)
(or (rng-memo-map-get value
- (rng-ipattern-get-memo-map-data-deriv ipattern))
+ (rng--ipattern-memo-map-data-deriv ipattern))
(and (rng-memo-map-get
(cons value (rng-namespace-context-get-no-trace))
- (rng-ipattern-get-memo-map-data-deriv ipattern))
+ (rng--ipattern-memo-map-data-deriv ipattern))
(rng-memo-map-get
(cons value (apply (car rng-dt-namespace-context-getter)
(cdr rng-dt-namespace-context-getter)))
- (rng-ipattern-get-memo-map-data-deriv ipattern)))
+ (rng--ipattern-memo-map-data-deriv ipattern)))
(let* ((used-context (vector nil))
(rng-dt-namespace-context-getter
(cons 'rng-namespace-context-tracer
@@ -1161,66 +1127,65 @@
(defun rng-ipattern-memo-data-deriv (ipattern value context deriv)
(or (memq ipattern rng-const-ipatterns)
(> (length value) rng-memo-data-deriv-max-length)
- (rng-ipattern-set-memo-map-data-deriv
- ipattern
- (rng-memo-map-add (if context (cons value context) value)
- deriv
- (rng-ipattern-get-memo-map-data-deriv ipattern)
- t)))
+ (setf (rng--ipattern-memo-map-data-deriv ipattern)
+ (rng-memo-map-add (if context (cons value context) value)
+ deriv
+ (rng--ipattern-memo-map-data-deriv ipattern)
+ t)))
deriv)
(defun rng-compute-data-deriv (ipattern value)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'text) ipattern)
((eq type 'choice)
- (rng-transform-choice `(lambda (p) (rng-data-deriv p ,value))
+ (rng-transform-choice (lambda (p) (rng-data-deriv p value))
ipattern))
((eq type 'group)
(rng-transform-group-nullable
- `(lambda (p) (rng-data-deriv p ,value))
+ (lambda (p) (rng-data-deriv p value))
(lambda (x y) (rng-intern-group (cons x y)))
ipattern))
((eq type 'one-or-more)
(rng-intern-group (list (rng-data-deriv
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
value)
(rng-intern-optional ipattern))))
((eq type 'after)
- (let ((child (rng-ipattern-get-child ipattern)))
- (if (or (rng-ipattern-get-nullable
+ (let ((child (rng--ipattern-child ipattern)))
+ (if (or (rng--ipattern-nullable
(rng-data-deriv child value))
- (and (rng-ipattern-get-nullable child)
+ (and (rng--ipattern-nullable child)
(rng-blank-p value)))
- (rng-ipattern-get-after ipattern)
+ (rng--ipattern-after ipattern)
rng-not-allowed-ipattern)))
((eq type 'data)
- (if (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'data-except)
- (if (and (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (and (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
- (not (rng-ipattern-get-nullable
+ (not (rng--ipattern-nullable
(rng-data-deriv
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
value))))
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'value)
- (if (equal (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (equal (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
- (rng-ipattern-get-value-object ipattern))
+ (rng--ipattern-value-object ipattern))
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'list)
(let ((tokens (split-string value))
- (state (rng-ipattern-get-child ipattern)))
+ (state (rng--ipattern-child ipattern)))
(while (and tokens
(not (eq state rng-not-allowed-ipattern)))
(setq state (rng-data-deriv state (car tokens)))
(setq tokens (cdr tokens)))
- (if (rng-ipattern-get-nullable state)
+ (if (rng--ipattern-nullable state)
rng-empty-ipattern
rng-not-allowed-ipattern)))
;; don't think interleave can occur
@@ -1228,7 +1193,7 @@
(t rng-not-allowed-ipattern))))
(defun rng-transform-multi (f ipattern interner)
- (let* ((members (rng-ipattern-get-child ipattern))
+ (let* ((members (rng--ipattern-child ipattern))
(transformed (mapcar f members)))
(if (rng-members-eq members transformed)
ipattern
@@ -1244,22 +1209,22 @@
(rng-transform-multi f ipattern 'rng-intern-interleave))
(defun rng-transform-one-or-more (f ipattern)
- (let* ((child (rng-ipattern-get-child ipattern))
+ (let* ((child (rng--ipattern-child ipattern))
(transformed (funcall f child)))
(if (eq child transformed)
ipattern
(rng-intern-one-or-more transformed))))
(defun rng-transform-after-child (f ipattern)
- (let* ((child (rng-ipattern-get-child ipattern))
+ (let* ((child (rng--ipattern-child ipattern))
(transformed (funcall f child)))
(if (eq child transformed)
ipattern
(rng-intern-after transformed
- (rng-ipattern-get-after ipattern)))))
+ (rng--ipattern-after ipattern)))))
(defun rng-transform-interleave-single (f subster ipattern)
- (let ((children (rng-ipattern-get-child ipattern))
+ (let ((children (rng--ipattern-child ipattern))
found)
(while (and children (not found))
(let* ((child (car children))
@@ -1270,7 +1235,7 @@
(funcall subster
transformed
child
- (rng-ipattern-get-child ipattern))))))
+ (rng--ipattern-child ipattern))))))
(or found
rng-not-allowed-ipattern)))
@@ -1286,14 +1251,14 @@
(rng-transform-group-nullable-gen-choices
f
conser
- (rng-ipattern-get-child ipattern))))
+ (rng--ipattern-child ipattern))))
(defun rng-transform-group-nullable-gen-choices (f conser members)
(let ((head (car members))
(tail (cdr members)))
(if tail
(cons (funcall conser (funcall f head) tail)
- (if (rng-ipattern-get-nullable head)
+ (if (rng--ipattern-nullable head)
(rng-transform-group-nullable-gen-choices f conser tail)
nil))
(list (funcall f head)))))
@@ -1308,11 +1273,11 @@
(defun rng-ipattern-after (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
(rng-transform-choice 'rng-ipattern-after ipattern))
((eq type 'after)
- (rng-ipattern-get-after ipattern))
+ (rng--ipattern-after ipattern))
((eq type 'not-allowed)
ipattern)
(t (error "Internal error in rng-ipattern-after: unexpected type %s"
type)))))
@@ -1321,7 +1286,7 @@
(rng-intern-after (rng-compile rng-any-content) ipattern))
(defun rng-ipattern-optionalize-elements (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern))
+ (let* ((type (rng--ipattern-type ipattern))
(transform (assq type rng-transform-map)))
(cond (transform
(funcall (cdr transform)
@@ -1332,11 +1297,11 @@
(t ipattern))))
(defun rng-ipattern-empty-before-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (eq (rng-ipattern-get-child ipattern) rng-empty-ipattern))
+ (eq (rng--ipattern-child ipattern) rng-empty-ipattern))
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(ret t))
(while (and members ret)
(or (rng-ipattern-empty-before-p (car members))
@@ -1346,13 +1311,13 @@
(t nil))))
(defun rng-ipattern-possible-start-tags (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(rng-ipattern-possible-start-tags
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
((memq type '(choice interleave))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-start-tags (car members)
@@ -1360,34 +1325,34 @@
(setq members (cdr members))))
accum)
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-start-tags (car members)
accum))
(setq members
- (and (rng-ipattern-get-nullable (car members))
+ (and (rng--ipattern-nullable (car members))
(cdr members)))))
accum)
((eq type 'element)
(if (eq (rng-element-get-child ipattern) rng-not-allowed-ipattern)
accum
(rng-name-class-possible-names
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
accum)))
((eq type 'one-or-more)
(rng-ipattern-possible-start-tags
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
(t accum))))
(defun rng-ipattern-start-tag-possible-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((memq type '(after one-or-more))
(rng-ipattern-start-tag-possible-p
- (rng-ipattern-get-child ipattern)))
+ (rng--ipattern-child ipattern)))
((memq type '(choice interleave))
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(possible nil))
(while (and members (not possible))
(setq possible
@@ -1395,13 +1360,13 @@
(setq members (cdr members)))
possible))
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(possible nil))
(while (and members (not possible))
(setq possible
(rng-ipattern-start-tag-possible-p (car members)))
(setq members
- (and (rng-ipattern-get-nullable (car members))
+ (and (rng--ipattern-nullable (car members))
(cdr members))))
possible))
((eq type 'element)
@@ -1410,12 +1375,12 @@
(t nil))))
(defun rng-ipattern-possible-attributes (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-possible-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-possible-attributes (rng--ipattern-child ipattern)
accum))
((memq type '(choice interleave group))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-attributes (car members)
@@ -1424,21 +1389,21 @@
accum)
((eq type 'attribute)
(rng-name-class-possible-names
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
accum))
((eq type 'one-or-more)
(rng-ipattern-possible-attributes
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
(t accum))))
(defun rng-ipattern-possible-values (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-possible-values (rng-ipattern-get-child ipattern)
+ (rng-ipattern-possible-values (rng--ipattern-child ipattern)
accum))
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-values (car members)
@@ -1446,18 +1411,18 @@
(setq members (cdr members))))
accum)
((eq type 'value)
- (let ((value-object (rng-ipattern-get-value-object ipattern)))
+ (let ((value-object (rng--ipattern-value-object ipattern)))
(if (stringp value-object)
(cons value-object accum)
accum)))
(t accum))))
(defun rng-ipattern-required-element (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((memq type '(after one-or-more))
- (rng-ipattern-required-element (rng-ipattern-get-child ipattern)))
+ (rng-ipattern-required-element (rng--ipattern-child ipattern)))
((eq type 'choice)
- (let* ((members (rng-ipattern-get-child ipattern))
+ (let* ((members (rng--ipattern-child ipattern))
(required (rng-ipattern-required-element (car members))))
(while (and required
(setq members (cdr members)))
@@ -1466,16 +1431,16 @@
(setq required nil)))
required))
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
required)
(while (and (not (setq required
(rng-ipattern-required-element
(car members))))
- (rng-ipattern-get-nullable (car members))
+ (rng--ipattern-nullable (car members))
(setq members (cdr members))))
required))
((eq type 'interleave)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
required)
(while members
(let ((tem (rng-ipattern-required-element (car members))))
@@ -1491,19 +1456,19 @@
(setq members nil)))))
required))
((eq type 'element)
- (let ((nc (rng-ipattern-get-name-class ipattern)))
+ (let ((nc (rng--ipattern-name-class ipattern)))
(and (consp nc)
(not (eq (rng-element-get-child ipattern)
rng-not-allowed-ipattern))
nc))))))
(defun rng-ipattern-required-attributes (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-required-attributes (rng--ipattern-child ipattern)
accum))
((memq type '(interleave group))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-required-attributes (car members)
@@ -1511,7 +1476,7 @@
(setq members (cdr members))))
accum)
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
in-all in-this new-in-all)
(setq in-all
(rng-ipattern-required-attributes (car members)
@@ -1528,12 +1493,12 @@
(setq in-all new-in-all))
(append in-all accum)))
((eq type 'attribute)
- (let ((nc (rng-ipattern-get-name-class ipattern)))
+ (let ((nc (rng--ipattern-name-class ipattern)))
(if (consp nc)
(cons nc accum)
accum)))
((eq type 'one-or-more)
- (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-required-attributes (rng--ipattern-child ipattern)
accum))
(t accum))))
@@ -1667,7 +1632,7 @@
ns))
(defun rng-match-nullable-p ()
- (rng-ipattern-get-nullable rng-match-state))
+ (rng--ipattern-nullable rng-match-state))
(defun rng-match-possible-start-tag-names ()
"Return a list of possible names that would be valid for start-tags.
@@ -1704,16 +1669,15 @@
(rng-ipattern-required-attributes rng-match-state nil))
(defmacro rng-match-save (&rest body)
+ (declare (indent 0) (debug t))
(let ((state (make-symbol "state")))
`(let ((,state rng-match-state))
(unwind-protect
(progn ,@body)
(setq rng-match-state ,state)))))
-(put 'rng-match-save 'lisp-indent-function 0)
-(def-edebug-spec rng-match-save t)
-
(defmacro rng-match-with-schema (schema &rest body)
+ (declare (indent 1) (debug t))
`(let ((rng-current-schema ,schema)
rng-match-state
rng-compile-table
@@ -1724,9 +1688,6 @@
(setq rng-match-state (rng-compile rng-current-schema))
,@body))
-(put 'rng-match-with-schema 'lisp-indent-function 1)
-(def-edebug-spec rng-match-with-schema t)
-
(provide 'rng-match)
;;; rng-match.el ends here
=== modified file 'lisp/nxml/xmltok.el'
--- a/lisp/nxml/xmltok.el 2013-08-09 21:22:44 +0000
+++ b/lisp/nxml/xmltok.el 2013-10-07 13:54:48 +0000
@@ -1,4 +1,4 @@
-;;; xmltok.el --- XML tokenization
+;;; xmltok.el --- XML tokenization -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
@@ -142,6 +142,7 @@
indicating the position of the error.")
(defmacro xmltok-save (&rest body)
+ (declare (indent 0) (debug t))
`(let (xmltok-type
xmltok-start
xmltok-name-colon
@@ -152,9 +153,6 @@
xmltok-errors)
,@body))
-(put 'xmltok-save 'lisp-indent-function 0)
-(def-edebug-spec xmltok-save t)
-
(defsubst xmltok-attribute-name-start (att)
(aref att 0))
@@ -411,7 +409,6 @@
(eval-when-compile
(let* ((or "\\|")
(open "\\(?:")
- (gopen "\\(")
(close "\\)")
(name-start-char "[_[:alpha:]]")
(name-continue-not-start-char "[-.[:digit:]]")
@@ -988,33 +985,6 @@
(xmltok-valid-char-p n)
n)))
-(defun xmltok-unclosed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter)
- (let ((len-1 (1- (length delimiter))))
- (goto-char (max start (- change-start len-1)))
- (search-forward delimiter (min end (+ change-end len-1)) t)))
-
-;; Handles a <!-- with the next -- not followed by >
-
-(defun xmltok-semi-closed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter
- delimiter-length)
- (or (<= (- end delimiter-length) change-end)
- (xmltok-unclosed-reparse-p change-start
- change-end
- pre-change-length
- start
- end
- delimiter)))
-
(defun xmltok-valid-char-p (n)
"Return non-nil if N is the Unicode code of a valid XML character."
(cond ((< n #x20) (memq n '(#xA #xD #x9)))
@@ -1072,7 +1042,7 @@
(setq xmltok-dtd xmltok-predefined-entity-alist)
(xmltok-scan-xml-declaration)
(xmltok-next-prolog-token)
- (while (condition-case err
+ (while (condition-case nil
(when (xmltok-parse-prolog-item)
(xmltok-next-prolog-token))
(xmltok-markup-declaration-parse-error
@@ -1371,7 +1341,7 @@
(t
(let ((xmltok-start (1- (point)))
xmltok-type xmltok-replacement)
- (xmltok-scan-after-amp (lambda (start end)))
+ (xmltok-scan-after-amp (lambda (_start _end)))
(cond ((eq xmltok-type 'char-ref)
(setq value-parts
(cons (buffer-substring-no-properties
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r114557: * lisp/nxml/nxml-mode.el: Use lexical-binding and syntax-propertize.,
Stefan Monnier <=