nxml-mode.el 87 KB
Newer Older
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1 2
;;; nxml-mode.el --- a new XML mode

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
4 5 6 7

;; Author: James Clark
;; Keywords: XML

Glenn Morris's avatar
Glenn Morris committed
8
;; This file is part of GNU Emacs.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
9

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Glenn Morris's avatar
Glenn Morris committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
14

Glenn Morris's avatar
Glenn Morris committed
15 16 17 18 19 20
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
22 23 24 25 26 27 28 29 30 31

;;; Commentary:

;; See nxml-rap.el for description of parsing strategy.

;;; Code:

(when (featurep 'mucs)
  (error "nxml-mode is not compatible with Mule-UCS"))

Glenn Morris's avatar
Glenn Morris committed
32 33
(eval-when-compile (require 'cl))	; for assert

Mark A. Hershberger's avatar
Mark A. Hershberger committed
34 35 36 37 38 39 40
(require 'xmltok)
(require 'nxml-enc)
(require 'nxml-glyph)
(require 'nxml-util)
(require 'nxml-rap)
(require 'nxml-outln)

41 42 43
(declare-function rng-nxml-mode-init "rng-nxml")
(declare-function nxml-enable-unicode-char-name-sets "nxml-uchnm")

Mark A. Hershberger's avatar
Mark A. Hershberger committed
44 45 46
;;; Customization

(defgroup nxml nil
47
  "New XML editing mode."
Mark A. Hershberger's avatar
Mark A. Hershberger committed
48 49 50
  :group 'languages
  :group 'wp)

51
(defgroup nxml-faces nil
Mark A. Hershberger's avatar
Mark A. Hershberger committed
52 53
  "Faces for XML syntax highlighting."
  :group 'nxml
54
  :group 'font-lock-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
55 56 57

(defcustom nxml-char-ref-display-glyph-flag t
  "*Non-nil means display glyph following character reference.
58
The glyph is displayed in face `nxml-glyph'.  The hook
Mark A. Hershberger's avatar
Mark A. Hershberger committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
`nxml-glyph-set-hook' can be used to customize for which characters
glyphs are displayed."
  :group 'nxml
  :type 'boolean)

(defcustom nxml-mode-hook nil
  "Hook run by command `nxml-mode'."
  :group 'nxml
  :type 'hook)

(defcustom nxml-sexp-element-flag nil
  "*Non-nil means sexp commands treat an element as a single expression."
  :group 'nxml
  :type 'boolean)

(defcustom nxml-slash-auto-complete-flag nil
  "*Non-nil means typing a slash automatically completes the end-tag.
This is used by `nxml-electric-slash'."
  :group 'nxml
  :type 'boolean)

(defcustom nxml-child-indent 2
  "*Indentation for the children of an element relative to the start-tag.
This only applies when the line or lines containing the start-tag contains
nothing else other than that start-tag."
  :group 'nxml
  :type 'integer)

(defcustom nxml-attribute-indent 4
  "*Indentation for the attributes of an element relative to the start-tag.
89 90 91
This only applies when the first attribute of a tag starts a line.
In other cases, the first attribute on one line is indented the same
as the first attribute on the previous line."
Mark A. Hershberger's avatar
Mark A. Hershberger committed
92 93 94 95 96 97 98 99
  :group 'nxml
  :type 'integer)

(defcustom nxml-bind-meta-tab-to-complete-flag (not window-system)
  "*Non-nil means bind M-TAB in `nxml-mode-map' to `nxml-complete'.
C-return will be bound to `nxml-complete' in any case.
M-TAB gets swallowed by many window systems/managers, and
`documentation' will show M-TAB rather than C-return as the
100
binding for `nxml-complete' when both are bound.  So it's better
Mark A. Hershberger's avatar
Mark A. Hershberger committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
to bind M-TAB only when it will work."
  :group 'nxml
  :set (lambda (sym flag)
	 (set-default sym flag)
	 (when (and (boundp 'nxml-mode-map) nxml-mode-map)
	   (define-key nxml-mode-map "\M-\t" (and flag 'nxml-complete))))
  :type 'boolean)

(defcustom nxml-prefer-utf-16-to-utf-8-flag nil
  "*Non-nil means prefer UTF-16 to UTF-8 when saving a buffer.
This is used only when a buffer does not contain an encoding declaration
and when its current `buffer-file-coding-system' specifies neither UTF-16
nor UTF-8."
  :group 'nxml
  :type 'boolean)

(defcustom nxml-prefer-utf-16-little-to-big-endian-flag (eq system-type
							    'windows-nt)
  "*Non-nil means prefer little-endian to big-endian byte-order for UTF-16.
This is used only for saving a buffer; when reading the byte-order is
auto-detected. It may be relevant both when there is no encoding declaration
and when the encoding declaration specifies `UTF-16'."
  :group 'nxml
  :type 'boolean)

(defcustom nxml-default-buffer-file-coding-system nil
  "*Default value for `buffer-file-coding-system' for a buffer for a new file.
128
A value of nil means use the default value of `buffer-file-coding-system' as normal.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
129 130 131 132 133 134 135 136 137 138
A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts."
  :group 'nxml
  :type 'coding-system)

(defcustom nxml-auto-insert-xml-declaration-flag nil
  "*Non-nil means automatically insert an XML declaration in a new file.
The XML declaration is inserted using `nxml-insert-xml-declaration'."
  :group 'nxml
  :type 'boolean)

139 140
(defface nxml-delimited-data
  '((t (:inherit font-lock-doc-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
141
  "Face used to highlight data enclosed between delimiters.
142 143
This is not used directly, but only via inheritance by other faces."
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
144

145 146
(defface nxml-name
  '((t (:inherit font-lock-builtin-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
147 148 149 150
  "Face used to highlight various names.
This includes element and attribute names, processing
instruction targets and the CDATA keyword in a CDATA section.
This is not used directly, but only via inheritance by other faces."
151
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
152

153 154
(defface nxml-ref
  '((t (:inherit font-lock-constant-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
155 156
  "Face used to highlight character and entity references.
This is not used directly, but only via inheritance by other faces."
157
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
158

159 160
(defface nxml-delimiter
  nil
Mark A. Hershberger's avatar
Mark A. Hershberger committed
161 162
  "Face used to highlight delimiters.
This is not used directly, but only via inheritance by other faces."
163
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
164

165
(defface nxml-text
Mark A. Hershberger's avatar
Mark A. Hershberger committed
166 167
  nil
  "Face used to highlight text."
168
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
169

170 171
(defface nxml-comment-content
  '((t (:inherit font-lock-comment-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
172
  "Face used to highlight the content of comments."
173
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
174

175 176
(defface nxml-comment-delimiter
  '((t (:inherit font-lock-comment-delimiter-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
177
  "Face used for the delimiters of comments, i.e <!-- and -->."
178
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
179

180 181
(defface nxml-processing-instruction-delimiter
  '((t (:inherit nxml-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
182
  "Face used for the delimiters of processing instructions, i.e <? and ?>."
183
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
184

185 186
(defface nxml-processing-instruction-target
  '((t (:inherit font-lock-keyword-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
187
  "Face used for the target of processing instructions."
188
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
189

190 191
(defface nxml-processing-instruction-content
  '((t (:inherit nxml-delimited-data)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
192
  "Face used for the content of processing instructions."
193
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
194

195 196
(defface nxml-cdata-section-delimiter
  '((t (:inherit nxml-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
197
  "Face used for the delimiters of CDATA sections, i.e <![, [, and ]]>."
198
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
199

200 201
(defface nxml-cdata-section-CDATA
  '((t (:inherit nxml-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
202
  "Face used for the CDATA keyword in CDATA sections."
203
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
204

205 206
(defface nxml-cdata-section-content
  '((t (:inherit nxml-text)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
207
  "Face used for the content of CDATA sections."
208
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
209

210 211
(defface nxml-char-ref-number
  '((t (:inherit nxml-ref)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
212 213
  "Face used for the number in character references.
This includes ths `x' in hex references."
214
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
215

216 217
(defface nxml-char-ref-delimiter
  '((t (:inherit nxml-ref)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
218
  "Face used for the delimiters of character references, i.e &# and ;."
219
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
220

221 222
(defface nxml-entity-ref-name
  '((t (:inherit nxml-ref)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
223
  "Face used for the entity name in general entity references."
224
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
225

226 227
(defface nxml-entity-ref-delimiter
  '((t (:inherit nxml-ref)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
228
  "Face used for the delimiters of entity references, i.e & and ;."
229
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
230

231 232
(defface nxml-tag-delimiter
  '((t (:inherit nxml-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
233
  "Face used for the angle brackets delimiting tags.
234 235
`nxml-tag-slash' is used for slashes."
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
236

237 238
(defface nxml-tag-slash
  '((t (:inherit nxml-tag-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
239
  "Face used for slashes in tags, both in end-tags and empty-elements."
240
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
241

242 243
(defface nxml-element-prefix
  '((t (:inherit nxml-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
244
  "Face used for the prefix of elements."
245
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
246

247 248
(defface nxml-element-colon
  nil
Mark A. Hershberger's avatar
Mark A. Hershberger committed
249
  "Face used for the colon in element names."
250
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
251

252 253
(defface nxml-element-local-name
  '((t (:inherit font-lock-function-name-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
254
  "Face used for the local name of elements."
255
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
256

257 258
(defface nxml-attribute-prefix
  '((t (:inherit nxml-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
259
  "Face used for the prefix of attributes."
260
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
261

262 263
(defface nxml-attribute-colon
  '((t (:inherit nxml-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
264
  "Face used for the colon in attribute names."
265
  :group 'nxml-faces)
266

267 268
(defface nxml-attribute-local-name
  '((t (:inherit font-lock-variable-name-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
269
  "Face used for the local name of attributes."
270
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
271

272 273
(defface nxml-namespace-attribute-xmlns
  '((t (:inherit nxml-attribute-prefix)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
274
  "Face used for `xmlns' in namespace attributes."
275
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
276

277 278
(defface nxml-namespace-attribute-colon
  '((t (:inherit nxml-attribute-colon)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
279
  "Face used for the colon in namespace attributes."
280
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
281

282 283
(defface nxml-namespace-attribute-prefix
  '((t (:inherit nxml-attribute-local-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
284
  "Face used for the prefix declared in namespace attributes."
285
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
286

287 288
(defface nxml-attribute-value
  '((t (:inherit font-lock-string-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
289
  "Face used for the value of attributes."
290
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
291

292 293
(defface nxml-attribute-value-delimiter
  '((t (:inherit nxml-attribute-value)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
294
  "Face used for the delimiters of attribute values."
295
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
296

297 298
(defface nxml-namespace-attribute-value
  '((t (:inherit nxml-attribute-value)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
299
  "Face used for the value of namespace attributes."
300
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
301

302 303
(defface nxml-namespace-attribute-value-delimiter
  '((t (:inherit nxml-attribute-value-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
304
  "Face used for the delimiters of namespace attribute values."
305
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
306

307 308
(defface nxml-prolog-literal-delimiter
  '((t (:inherit nxml-delimited-data)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
309
  "Face used for the delimiters of literals in the prolog."
310
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
311

312 313
(defface nxml-prolog-literal-content
  '((t (:inherit nxml-delimited-data)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
314
  "Face used for the content of literals in the prolog."
315
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
316

317 318
(defface nxml-prolog-keyword
  '((t (:inherit font-lock-keyword-face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
319
  "Face used for keywords in the prolog."
320
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
321

322 323
(defface nxml-markup-declaration-delimiter
  '((t (:inherit nxml-delimiter)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
324 325
  "Face used for the delimiters of markup declarations in the prolog.
The delimiters are <! and >."
326
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
327

328 329
(defface nxml-hash
  '((t (:inherit nxml-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
330
  "Face used for # before a name in the prolog."
331
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
332

333
(defface nxml-glyph
Mark A. Hershberger's avatar
Mark A. Hershberger committed
334 335 336 337 338 339 340 341
  '((((type x))
     (:family
      "misc-fixed"
      :background
      "light grey"
      :foreground
      "black"
      :weight
342
      normal
Mark A. Hershberger's avatar
Mark A. Hershberger committed
343 344 345 346 347 348 349 350
      :slant
      normal))
    (t
     (:background
      "light grey"
      :foreground
      "black"
      :weight
351
      normal
Mark A. Hershberger's avatar
Mark A. Hershberger committed
352 353 354
      :slant
      normal)))
  "Face used for glyph for char references."
355
  :group 'nxml-faces)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
356 357 358 359 360 361 362 363 364 365

;;; Global variables

(defvar nxml-prolog-regions nil
  "List of regions in the prolog to be fontified.
See the function `xmltok-forward-prolog' for more information.")
(make-variable-buffer-local 'nxml-prolog-regions)

(defvar nxml-last-fontify-end nil
  "Position where fontification last ended.
366
It is nil if the buffer changed since the last fontification.")
Mark A. Hershberger's avatar
Mark A. Hershberger committed
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
(make-variable-buffer-local 'nxml-last-fontify-end)

(defvar nxml-degraded nil
  "Non-nil if currently operating in degraded mode.
Degraded mode is enabled when an internal error is encountered in the
fontification or after-change functions.")
(make-variable-buffer-local 'nxml-degraded)

(defvar nxml-completion-hook nil
  "Hook run by `nxml-complete'.
This hook is run until success.")

(defvar nxml-in-mixed-content-hook nil
  "Hook to determine whether point is in mixed content.
The hook is called without arguments.  It should return nil if it is
definitely not mixed; non-nil otherwise.  The hook will be run until
one of the functions returns nil.")

(defvar nxml-mixed-scan-distance 4000
  "Maximum distance from point to scan when checking for mixed content.")

(defvar nxml-end-tag-indent-scan-distance 4000
  "Maximum distance from point to scan backwards when indenting end-tag.")

(defvar nxml-char-ref-extra-display t
  "Non-nil means display extra information for character references.
The extra information consists of a tooltip with the character name
and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph
corresponding to the referenced character following the character
reference.")
(make-variable-buffer-local 'nxml-char-ref-extra-display)

(defvar nxml-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\M-\C-u" 'nxml-backward-up-element)
    (define-key map "\M-\C-d" 'nxml-down-element)
    (define-key map "\M-\C-n" 'nxml-forward-element)
    (define-key map "\M-\C-p" 'nxml-backward-element)
    (define-key map "\M-{" 'nxml-backward-paragraph)
    (define-key map "\M-}" 'nxml-forward-paragraph)
    (define-key map "\M-h" 'nxml-mark-paragraph)
    (define-key map "\C-c\C-f" 'nxml-finish-element)
    (define-key map "\C-c\C-m" 'nxml-split-element)
    (define-key map "\C-c\C-b" 'nxml-balanced-close-start-tag-block)
    (define-key map "\C-c\C-i" 'nxml-balanced-close-start-tag-inline)
    (define-key map "\C-c\C-x" 'nxml-insert-xml-declaration)
    (define-key map "\C-c\C-d" 'nxml-dynamic-markup-word)
    ;; u is for Unicode
    (define-key map "\C-c\C-u" 'nxml-insert-named-char)
    (define-key map "\C-c\C-o" nxml-outline-prefix-map)
    (define-key map [S-mouse-2] 'nxml-mouse-hide-direct-text-content)
    (define-key map "/" 'nxml-electric-slash)
419
    (define-key map [C-return] 'nxml-complete)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
420 421 422 423 424
    (when nxml-bind-meta-tab-to-complete-flag
      (define-key map "\M-\t" 'nxml-complete))
    map)
  "Keymap for nxml-mode.")

Michael Olson's avatar
Michael Olson committed
425 426 427 428
(defvar nxml-font-lock-keywords
  '(nxml-fontify-matcher)
  "Default font lock keywords for nxml-mode.")

Mark A. Hershberger's avatar
Mark A. Hershberger committed
429 430
(defsubst nxml-set-face (start end face)
  (when (and face (< start end))
Michael Olson's avatar
Michael Olson committed
431
    (font-lock-append-text-property start end 'face face)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
432 433 434 435 436 437 438 439 440 441

;;;###autoload
(defun nxml-mode ()
  ;; We use C-c C-i instead of \\[nxml-balanced-close-start-tag-inline]
  ;; because Emacs turns C-c C-i into C-c TAB which is hard to type and
  ;; not mnemonic.
  "Major mode for editing XML.

\\[nxml-finish-element] finishes the current element by inserting an end-tag.
C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag
442
leaving point between the start-tag and end-tag.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461
\\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements:
the start-tag, point, and end-tag are all left on separate lines.
If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</'
automatically inserts the rest of the end-tag.

\\[nxml-complete] performs completion on the symbol preceding point.

\\[nxml-dynamic-markup-word] uses the contents of the current buffer
to choose a tag to put around the word preceding point.

Sections of the document can be displayed in outline form.  The
variable `nxml-section-element-name-regexp' controls when an element
is recognized as a section.  The same key sequences that change
visibility in outline mode are used except that they start with C-c C-o
instead of C-c.

Validation is provided by the related minor-mode `rng-validate-mode'.
This also makes completion schema- and context- sensitive.  Element
names, attribute names, attribute values and namespace URIs can all be
462 463
completed. By default, `rng-validate-mode' is automatically enabled.
You can toggle it using \\[rng-validate-mode] or change the default by
464
customizing `rng-nxml-auto-validate-flag'.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
465 466 467 468 469 470

\\[indent-for-tab-command] indents the current line appropriately.
This can be customized using the variable `nxml-child-indent'
and the variable `nxml-attribute-indent'.

\\[nxml-insert-named-char] inserts a character reference using
471 472
the character's name (by default, the Unicode name).
\\[universal-argument] \\[nxml-insert-named-char] inserts the character directly.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491

The Emacs commands that normally operate on balanced expressions will
operate on XML markup items.  Thus \\[forward-sexp] will move forward
across one markup item; \\[backward-sexp] will move backward across
one markup item; \\[kill-sexp] will kill the following markup item;
\\[mark-sexp] will mark the following markup item.  By default, each
tag each treated as a single markup item; to make the complete element
be treated as a single markup item, set the variable
`nxml-sexp-element-flag' to t.  For more details, see the function
`nxml-forward-balanced-item'.

\\[nxml-backward-up-element] and \\[nxml-down-element] move up and down the element structure.

Many aspects this mode can be customized using
\\[customize-group] nxml RET."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'nxml-mode)
  (setq mode-name "nXML")
492
  (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded")))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523
  ;; We'll determine the fill prefix ourselves
  (make-local-variable 'adaptive-fill-mode)
  (setq adaptive-fill-mode nil)
  (make-local-variable 'forward-sexp-function)
  (setq forward-sexp-function 'nxml-forward-balanced-item)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'nxml-indent-line)
  (make-local-variable 'fill-paragraph-function)
  (setq fill-paragraph-function 'nxml-do-fill-paragraph)
  ;; Comment support
  ;; This doesn't seem to work too well;
  ;; I think we should probably roll our own nxml-comment-dwim function.
  (make-local-variable 'comment-indent-function)
  (setq comment-indent-function 'nxml-indent-line)
  (make-local-variable 'comment-start)
  (setq comment-start "<!--")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "<!--[ \t\r\n]*")
  (make-local-variable 'comment-end)
  (setq comment-end "-->")
  (make-local-variable 'comment-end-skip)
  (setq comment-end-skip "[ \t\r\n]*-->")
  (make-local-variable 'comment-line-break-function)
  (setq comment-line-break-function 'nxml-newline-and-indent)
  (use-local-map nxml-mode-map)
  (save-excursion
    (save-restriction
      (widen)
      (nxml-clear-dependent-regions (point-min) (point-max))
      (setq nxml-scan-end (copy-marker (point-min) nil))
      (nxml-with-unmodifying-text-property-changes
Michael Olson's avatar
Michael Olson committed
524
        (nxml-clear-inside (point-min) (point-max))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
525 526 527
	(nxml-with-invisible-motion
	  (nxml-scan-prolog)))))
  (add-hook 'after-change-functions 'nxml-after-change nil t)
528 529
  (add-hook 'change-major-mode-hook 'nxml-cleanup nil t)

530 531 532 533 534
  ;; 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)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
535 536 537 538 539 540
  (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)))
      (setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
    (when nxml-auto-insert-xml-declaration-flag
      (nxml-insert-xml-declaration)))
Michael Olson's avatar
Michael Olson committed
541 542 543 544 545 546 547 548 549 550 551 552 553

  (setq font-lock-defaults
        '(nxml-font-lock-keywords
          t    ; keywords-only; we highlight comments and strings here
          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)))

554
  (rng-nxml-mode-init)
555
  (nxml-enable-unicode-char-name-sets)
556
  (run-mode-hooks 'nxml-mode-hook))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
557

558 559 560 561 562 563 564 565 566 567 568 569 570 571 572
(defun nxml-cleanup ()
  "Clean up after nxml-mode."
  ;; Disable associated minor modes.
  (rng-validate-mode -1)
  ;; Clean up fontification.
  (save-excursion
    (widen)
    (let ((inhibit-read-only t)
	  (buffer-undo-list t)
	  (modified (buffer-modified-p)))
      (nxml-with-invisible-motion
       (remove-text-properties (point-min) (point-max) '(face)))
      (set-buffer-modified-p modified)))
  (remove-hook 'change-major-mode-hook 'nxml-cleanup t))

Mark A. Hershberger's avatar
Mark A. Hershberger committed
573 574 575 576 577 578 579 580 581 582 583
(defun nxml-degrade (context err)
  (message "Internal nXML mode error in %s (%s), degrading"
	   context
	   (error-message-string err))
  (ding)
  (setq nxml-degraded t)
  (setq nxml-prolog-end 1)
  (save-excursion
    (save-restriction
      (widen)
      (nxml-with-unmodifying-text-property-changes
584
	(nxml-clear-inside (point-min) (point-max))))))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
585 586 587

;;; Change management

Michael Olson's avatar
Michael Olson committed
588 589 590 591 592 593 594 595
(defun nxml-debug-region (start end)
  (interactive "r")
  (let ((font-lock-beg start)
        (font-lock-end end))
    (nxml-extend-region)
    (goto-char font-lock-beg)
    (set-mark font-lock-end)))

Mark A. Hershberger's avatar
Mark A. Hershberger committed
596
(defun nxml-after-change (start end pre-change-length)
Michael Olson's avatar
Michael Olson committed
597 598 599 600 601 602 603 604 605 606 607 608 609
  ; 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)
    (nxml-with-degradation-on-error 'nxml-after-change
        (save-excursion
          (save-restriction
            (widen)
            (save-match-data
              (nxml-with-invisible-motion
                (nxml-with-unmodifying-text-property-changes
                  (nxml-after-change1
                   start end pre-change-length)))))))))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
610 611

(defun nxml-after-change1 (start end pre-change-length)
612 613 614 615
  "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
the full extent of the area needing refontification.
Michael Olson's avatar
Michael Olson committed
616 617 618

For bookkeeping, call this function even when fontification is
disabled."
Mark A. Hershberger's avatar
Mark A. Hershberger committed
619 620 621 622 623
  (let ((pre-change-end (+ start pre-change-length)))
    (setq start
	  (nxml-adjust-start-for-dependent-regions start
						   end
						   pre-change-length))
Michael Olson's avatar
Michael Olson committed
624
    ;; If the prolog might have changed, rescan the prolog
Mark A. Hershberger's avatar
Mark A. Hershberger committed
625
    (when (<= start
Michael Olson's avatar
Michael Olson committed
626 627 628
	      ;; 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.
Mark A. Hershberger's avatar
Mark A. Hershberger committed
629
	      (+ nxml-prolog-end 2))
Michael Olson's avatar
Michael Olson committed
630 631
      ;; end must be extended to at least the end of the old prolog in
      ;; case the new prolog is shorter
Mark A. Hershberger's avatar
Mark A. Hershberger committed
632 633 634 635 636 637
      (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)))))
Michael Olson's avatar
Michael Olson committed
638 639 640 641 642 643 644 645 646 647 648 649 650
      (nxml-scan-prolog)
      (setq start (point-min))))

  (when (> end nxml-prolog-end)
    (goto-char start)
    (nxml-move-tag-backwards (point-min))
    (setq start (point))
    (setq end (max (nxml-scan-after-change start end)
                   end)))

  (nxml-debug-change "nxml-after-change1" start end)
  (cons start end))

Mark A. Hershberger's avatar
Mark A. Hershberger committed
651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802
;;; Encodings

(defun nxml-insert-xml-declaration ()
  "Insert an XML declaration at the beginning of buffer.
The XML declaration will declare an encoding depending on the buffer's
`buffer-file-coding-system'."
  (interactive "*")
  (let ((coding-system
	 (if (and buffer-file-coding-system
		  (coding-system-p buffer-file-coding-system)
		  (coding-system-get buffer-file-coding-system
				     'mime-charset))
	     buffer-file-coding-system
	   (nxml-choose-utf-coding-system))))
    (goto-char (point-min))
    (insert (format "<?xml version=\"1.0\" encoding=\"%s\"?>\n"
		    (nxml-coding-system-name coding-system)))))

(defun nxml-prepare-to-save ()
  (unless (and (not enable-multibyte-characters)
	       (local-variable-p 'buffer-file-coding-system)
	       buffer-file-coding-system
	       (or (eq (coding-system-type buffer-file-coding-system) 5)
		   (eq buffer-file-coding-system 'no-conversion)))
    (save-excursion
      (setq buffer-file-coding-system (nxml-select-coding-system))))
  ;; nil from a function in `write-contents-hooks' means
  ;; to continue and write the file as normal
  nil)

(defun nxml-select-coding-system ()
  (let* ((suitable-coding-systems
	  (find-coding-systems-region (point-min) (point-max)))
	 (enc-pos (progn
		    (goto-char (point-min))
		    (xmltok-get-declared-encoding-position)))
	 (enc-name
	  (and (consp enc-pos)
	       (buffer-substring-no-properties (car enc-pos)
					       (cdr enc-pos))))
	 (coding-system
	  (cond (enc-name
		 (if (string= (downcase enc-name) "utf-16")
		     (nxml-choose-utf-16-coding-system)
		   (nxml-mime-charset-coding-system enc-name)))
		(enc-pos (nxml-choose-utf-coding-system)))))
    ;; Make sure we have a coding-system
    (unless coding-system
      (setq coding-system
	    (and (not buffer-read-only)
		 (nxml-choose-suitable-coding-system
		  suitable-coding-systems)))
      (let ((message
	     (if enc-name
		 (format "Unknown encoding %s" enc-name)
	       "XML declaration is not well-formed")))
	(cond ((not coding-system)
	       (error "%s" message))
	      ((y-or-n-p
		(concat message
			". "
			(format (if enc-name
				    "Save with %s"
				  "Modify and save with encoding %s")
				(nxml-coding-system-name coding-system))
			" "))
	       (nxml-fix-encoding-declaration enc-pos coding-system))
	      (t (signal 'quit nil)))))
    ;; Make sure it can encode all the characters in the buffer
    (unless (or (memq (coding-system-base coding-system)
		      suitable-coding-systems)
		(equal suitable-coding-systems '(undecided)))
      (let ((message
	     (nxml-unsuitable-coding-system-message coding-system
						    enc-name)))
	(setq coding-system
	      (and (not buffer-read-only)
		   (nxml-choose-suitable-coding-system
		    suitable-coding-systems)))
	(cond ((not coding-system) (error "%s" message))
	      ((y-or-n-p (concat message
				 (format ". Save with %s "
					 (nxml-coding-system-name
					  coding-system))))
	       (nxml-fix-encoding-declaration enc-pos coding-system))
	      (t (signal 'quit nil)))))
    ;; Merge the newline type of our existing encoding
    (let ((current-eol-type
	   (coding-system-eol-type buffer-file-coding-system)))
      (when (and current-eol-type (integerp current-eol-type))
	(setq coding-system
	      (coding-system-change-eol-conversion coding-system
						   current-eol-type))))
    coding-system))

(defun nxml-unsuitable-coding-system-message (coding-system &optional enc-name)
  (if (nxml-coding-system-unicode-p coding-system)
      "Cannot translate some characters to Unicode"
    (format "Cannot encode some characters with %s"
	    (or enc-name
		(nxml-coding-system-name coding-system)))))

(defconst nxml-utf-16-coding-systems (and (coding-system-p 'utf-16-be)
					  (coding-system-p 'utf-16-le)
					  '(utf-16-be utf-16-le)))

(defconst nxml-utf-coding-systems (cons 'utf-8 nxml-utf-16-coding-systems))

(defun nxml-coding-system-unicode-p (coding-system)
  (nxml-coding-system-member (coding-system-base coding-system)
			     nxml-utf-coding-systems))

(defun nxml-coding-system-name (coding-system)
  (setq coding-system (coding-system-base coding-system))
  (symbol-name
   (if (nxml-coding-system-member coding-system nxml-utf-16-coding-systems)
       'utf-16
     (or (coding-system-get coding-system 'mime-charset)
	 coding-system))))

(defun nxml-fix-encoding-declaration (enc-pos coding-system)
  (let ((charset (nxml-coding-system-name coding-system)))
    (cond ((consp enc-pos)
	   (delete-region (car enc-pos) (cdr enc-pos))
	   (goto-char (car enc-pos))
	   (insert charset))
	  ((integerp enc-pos)
	   (goto-char enc-pos)
	   (insert " encoding=\"" charset ?\"))
	  (t
	   (goto-char (point-min))
	   (insert "<?xml version=\"1.0\" encoding=\""
		   charset
		   "\"?>\n")
	   (when (and (not enc-pos)
		      (let ((case-fold-search t))
			(looking-at xmltok-bad-xml-decl-regexp)))
	     (delete-region (point) (match-end 0)))))))

(defun nxml-choose-suitable-coding-system (suitable-coding-systems)
  (let (ret coding-system)
    (if (and buffer-file-coding-system
	     (memq (coding-system-base buffer-file-coding-system)
		   suitable-coding-systems))
	buffer-file-coding-system
      (while (and suitable-coding-systems (not ret))
	(setq coding-system (car suitable-coding-systems))
	(if (coding-system-get coding-system 'mime-charset)
	    (setq ret coding-system)
	  (setq suitable-coding-systems (cdr suitable-coding-systems))))
      ret)))

803
(defun nxml-choose-utf-coding-system ()
Mark A. Hershberger's avatar
Mark A. Hershberger committed
804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835
  (let ((cur (and (local-variable-p 'buffer-file-coding-system)
		  buffer-file-coding-system
		  (coding-system-base buffer-file-coding-system))))
    (cond ((car (nxml-coding-system-member cur nxml-utf-coding-systems)))
	  ((and nxml-prefer-utf-16-to-utf-8-flag
		(coding-system-p 'utf-16-le)
		(coding-system-p 'utf-16-be))
	   (if nxml-prefer-utf-16-little-to-big-endian-flag
	       'utf-16-le
	     'utf-16-be))
	  (t 'utf-8))))

(defun nxml-choose-utf-16-coding-system ()
  (let ((cur (and (local-variable-p 'buffer-file-coding-system)
		  buffer-file-coding-system
		  (coding-system-base buffer-file-coding-system))))
    (cond ((car (nxml-coding-system-member cur nxml-utf-16-coding-systems)))
	  (nxml-prefer-utf-16-little-to-big-endian-flag
	   (and (coding-system-p 'utf-16-le) 'utf-16-le))
	  (t (and (coding-system-p 'utf-16-be) 'utf-16-be)))))

(defun nxml-coding-system-member (coding-system coding-systems)
  (let (ret)
    (while (and coding-systems (not ret))
      (if (coding-system-equal coding-system
			       (car coding-systems))
	  (setq ret coding-systems)
	(setq coding-systems (cdr coding-systems))))
    ret))

;;; Fontification

Michael Olson's avatar
Michael Olson committed
836 837 838 839 840 841 842
(defun nxml-unfontify-region (start end)
  (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.
843
Called with `font-lock-beg' and `font-lock-end' dynamically bound."
Michael Olson's avatar
Michael Olson committed
844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927
  (let ((start font-lock-beg)
        (end font-lock-end))

    (nxml-debug-change "nxml-extend-region(input)" start end)

    (when (< start nxml-prolog-end)
      (setq start (point-min)))

    (cond ((<= end nxml-prolog-end)
           (setq end nxml-prolog-end))

          (t
           (goto-char start)
           ;; some font-lock backends (like Emacs 22 jit-lock) snap
           ;; the region to the beginning of the line no matter what
           ;; we say here. To mitigate the resulting excess
           ;; fontification, ignore leading whitespace.
           (skip-syntax-forward " ")

           ;; find the beginning of the previous tag
           (when (not (equal (char-after) ?\<))
             (search-backward "<" nxml-prolog-end t))
           (nxml-ensure-scan-up-to-date)
           (nxml-move-outside-backwards)
           (setq start (point))

           (while (< (point) end)
             (nxml-tokenize-forward))

           (setq end (point))))

    (when (or (< start font-lock-beg)
              (> end font-lock-end))
      (setq font-lock-beg start
            font-lock-end end)
      (nxml-debug-change "nxml-extend-region" start end)
      t)))

(defun nxml-extend-after-change-region (start end pre-change-length)
  (unless nxml-degraded
    (setq nxml-last-fontify-end nil)

    (nxml-with-degradation-on-error 'nxml-extend-after-change-region
	(save-excursion
	  (save-restriction
	    (widen)
	    (save-match-data
	      (nxml-with-invisible-motion
		(nxml-with-unmodifying-text-property-changes
                  (nxml-extend-after-change-region1
                   start end pre-change-length)))))))))

(defun nxml-extend-after-change-region1 (start end pre-change-length)
  (let* ((region (nxml-after-change1 start end pre-change-length))
         (font-lock-beg (car region))
         (font-lock-end (cdr region)))

    (nxml-extend-region)
    (cons font-lock-beg font-lock-end)))

(defun nxml-fontify-matcher (bound)
  "Called as font-lock keyword matcher."

  (unless nxml-degraded
    (nxml-debug-change "nxml-fontify-matcher" (point) bound)

    (when (< (point) nxml-prolog-end)
      ;; prolog needs to be fontified in one go, and
      ;; nxml-extend-region makes sure we start at BOB.
      (assert (bobp))
      (nxml-fontify-prolog)
      (goto-char nxml-prolog-end))

    (let (xmltok-dependent-regions
          xmltok-errors)
      (while (and (nxml-tokenize-forward)
                  (<= (point) bound)) ; intervals are open-ended
        (nxml-apply-fontify-rule)))

    (setq nxml-last-fontify-end (point)))

  ;; Since we did the fontification internally, tell font-lock to not
  ;; do anything itself.
  nil)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947

(defun nxml-fontify-prolog ()
  "Fontify the prolog.
The buffer is assumed to be prepared for fontification.
This does not set the fontified property, but it does clear
faces appropriately."
  (let ((regions nxml-prolog-regions))
    (while regions
      (let ((region (car regions)))
	(nxml-apply-fontify-rule (aref region 0)
				 (aref region 1)
				 (aref region 2)))
      (setq regions (cdr regions)))))

;; Vectors identify a substring of the token to be highlighted in some face.

;; Token types returned by xmltok-forward.

(put 'start-tag
     'nxml-fontify-rule
948 949
     '([nil 1 nxml-tag-delimiter]
       [-1 nil nxml-tag-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
950 951 952 953 954
       (element-qname . 1)
       attributes))

(put 'partial-start-tag
     'nxml-fontify-rule
955
     '([nil 1 nxml-tag-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
956 957 958 959 960
       (element-qname . 1)
       attributes))

(put 'end-tag
     'nxml-fontify-rule
961 962 963
     '([nil 1 nxml-tag-delimiter]
       [1 2 nxml-tag-slash]
       [-1 nil nxml-tag-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
964 965 966 967
       (element-qname . 2)))

(put 'partial-end-tag
     'nxml-fontify-rule
968 969
     '([nil 1 nxml-tag-delimiter]
       [1 2 nxml-tag-slash]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
970 971 972 973
       (element-qname . 2)))

(put 'empty-element
     'nxml-fontify-rule
974 975 976
     '([nil 1 nxml-tag-delimiter]
       [-2 -1 nxml-tag-slash]
       [-1 nil nxml-tag-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
977 978 979 980 981
       (element-qname . 1)
       attributes))

(put 'partial-empty-element
     'nxml-fontify-rule
982 983
     '([nil 1 nxml-tag-delimiter]
       [-1 nil nxml-tag-slash]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
984 985 986 987 988
       (element-qname . 1)
       attributes))

(put 'char-ref
     'nxml-fontify-rule
989 990 991
     '([nil 2 nxml-char-ref-delimiter]
       [2 -1 nxml-char-ref-number]
       [-1 nil nxml-char-ref-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
992 993 994 995
       char-ref))

(put 'entity-ref
     'nxml-fontify-rule
996 997 998
     '([nil 1 nxml-entity-ref-delimiter]
       [1 -1 nxml-entity-ref-name]
       [-1 nil nxml-entity-ref-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
999 1000 1001

(put 'comment
     'nxml-fontify-rule
1002 1003 1004
     '([nil 4 nxml-comment-delimiter]
       [4 -3 nxml-comment-content]
       [-3 nil nxml-comment-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1005 1006 1007

(put 'processing-instruction
     'nxml-fontify-rule
1008 1009
     '([nil 2 nxml-processing-instruction-delimiter]
       [-2 nil nxml-processing-instruction-delimiter]
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1010 1011 1012 1013
       processing-instruction-content))

(put 'cdata-section
     'nxml-fontify-rule
1014 1015 1016 1017 1018
     '([nil 3 nxml-cdata-section-delimiter] ; <![
       [3 8 nxml-cdata-section-CDATA] ; CDATA
       [8 9 nxml-cdata-section-delimiter] ; [
       [9 -3 nxml-cdata-section-content] ; ]]>
       [-3 nil nxml-cdata-section-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1019 1020 1021

(put 'data
     'nxml-fontify-rule
1022
     '([nil nil nxml-text]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1023 1024 1025 1026 1027

;; Prolog region types in list returned by xmltok-forward-prolog.

(put 'xml-declaration
     'nxml-fontify-rule
1028 1029 1030
     '([nil 2 nxml-processing-instruction-delimiter]
       [2 5 nxml-processing-instruction-target]
       [-2 nil nxml-processing-instruction-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1031 1032 1033

(put 'xml-declaration-attribute-name
     'nxml-fontify-rule
1034
     '([nil nil nxml-attribute-local-name]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1035 1036 1037

(put 'xml-declaration-attribute-value
     'nxml-fontify-rule
1038 1039 1040
     '([nil 1 nxml-attribute-value-delimiter]
       [1 -1 nxml-attribute-value]
       [-1 nil nxml-attribute-value-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1041 1042 1043

(put 'processing-instruction-left
     'nxml-fontify-rule
1044 1045
     '([nil 2 nxml-processing-instruction-delimiter]
       [2 nil nxml-processing-instruction-target]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1046 1047 1048

(put 'processing-instruction-right
     'nxml-fontify-rule
1049 1050
     '([nil -2 nxml-processing-instruction-content]
       [-2 nil nxml-processing-instruction-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1051 1052 1053

(put 'literal
     'nxml-fontify-rule
1054 1055 1056
     '([nil 1 nxml-prolog-literal-delimiter]
       [1 -1 nxml-prolog-literal-content]
       [-1 nil nxml-prolog-literal-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1057 1058 1059

(put 'keyword
     'nxml-fontify-rule
1060
     '([nil nil nxml-prolog-keyword]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1061 1062 1063

(put 'markup-declaration-open
     'nxml-fontify-rule
1064 1065
     '([0 2 nxml-markup-declaration-delimiter]
       [2 nil nxml-prolog-keyword]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1066 1067 1068

(put 'markup-declaration-close
     'nxml-fontify-rule
1069
     '([nil nil nxml-markup-declaration-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1070 1071 1072

(put 'internal-subset-open
     'nxml-fontify-rule
1073
     '([nil nil nxml-markup-declaration-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1074 1075 1076

(put 'internal-subset-close
     'nxml-fontify-rule
1077 1078
     '([nil 1 nxml-markup-declaration-delimiter]
       [-1 nil nxml-markup-declaration-delimiter]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1079 1080 1081

(put 'hash-name
     'nxml-fontify-rule
1082 1083
     '([nil 1 nxml-hash]
       [1 nil nxml-prolog-keyword]))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107

(defun nxml-apply-fontify-rule (&optional type start end)
  (let ((rule (get (or type xmltok-type) 'nxml-fontify-rule)))
    (unless start (setq start xmltok-start))
    (unless end (setq end (point)))
    (while rule
      (let* ((action (car rule)))
	(setq rule (cdr rule))
	(cond ((vectorp action)
	       (nxml-set-face (let ((offset (aref action 0)))
				(cond ((not offset) start)
				      ((< offset 0) (+ end offset))
				      (t (+ start offset))))
			      (let ((offset (aref action 1)))
				(cond ((not offset) end)
				      ((< offset 0) (+ end offset))
				      (t (+ start offset))))
			      (aref action 2)))
	      ((and (consp action)
		    (eq (car action) 'element-qname))
	       (when xmltok-name-end ; maybe nil in partial-end-tag case
		 (nxml-fontify-qname (+ start (cdr action))
				     xmltok-name-colon
				     xmltok-name-end
1108 1109 1110
				     'nxml-element-prefix
				     'nxml-element-colon
				     'nxml-element-local-name)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1111 1112 1113 1114 1115
	      ((eq action 'attributes)
	       (nxml-fontify-attributes))
	      ((eq action 'processing-instruction-content)
	       (nxml-set-face (+ start 2)
			      xmltok-name-end
1116
			      'nxml-processing-instruction-target)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1117 1118 1119 1120 1121
	       (nxml-set-face (save-excursion
				(goto-char xmltok-name-end)
				(skip-chars-forward " \t\r\n")
				(point))
			      (- end 2)
1122
			      'nxml-processing-instruction-content))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144
	      ((eq action 'char-ref)
	       (nxml-char-ref-display-extra start
					    end
					    (xmltok-char-number start end)))
	      (t (error "Invalid nxml-fontify-rule action %s" action)))))))

(defun nxml-fontify-attributes ()
  (while xmltok-namespace-attributes
    (nxml-fontify-attribute (car xmltok-namespace-attributes)
			    'namespace)
    (setq xmltok-namespace-attributes
	  (cdr xmltok-namespace-attributes)))
  (while xmltok-attributes
    (nxml-fontify-attribute (car xmltok-attributes))
    (setq xmltok-attributes
	  (cdr xmltok-attributes))))

(defun nxml-fontify-attribute (att &optional namespace-declaration)
  (if namespace-declaration
      (nxml-fontify-qname (xmltok-attribute-name-start att)
			  (xmltok-attribute-name-colon att)
			  (xmltok-attribute-name-end att)
1145 1146 1147 1148
			  'nxml-namespace-attribute-xmlns
			  'nxml-namespace-attribute-colon
			  'nxml-namespace-attribute-prefix
			  'nxml-namespace-attribute-xmlns)
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1149 1150 1151
    (nxml-fontify-qname (xmltok-attribute-name-start att)
			(xmltok-attribute-name-colon att)
			(xmltok-attribute-name-end att)
1152 1153 1154
			'nxml-attribute-prefix
			'nxml-attribute-colon
			'nxml-attribute-local-name))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1155 1156 1157 1158
  (let ((start (xmltok-attribute-value-start att))
	(end (xmltok-attribute-value-end att))
	(refs (xmltok-attribute-refs att))
	(delimiter-face (if namespace-declaration
1159 1160
			    'nxml-namespace-attribute-value-delimiter
			  'nxml-attribute-value-delimiter))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1161
	(value-face (if namespace-declaration
1162 1163
			'nxml-namespace-attribute-value
		      'nxml-attribute-value)))
Mark A. Hershberger's avatar
Mark A. Hershberger committed
1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239