| 1 | ;;; nxml-mode.el --- a new XML mode -*- lexical-binding:t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2003-2004, 2007-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: James Clark |
| 6 | ;; Keywords: wp, hypermedia, languages, XML |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; 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/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; See nxml-rap.el for description of parsing strategy. |
| 26 | |
| 27 | ;;; Code: |
| 28 | |
| 29 | (when (featurep 'mucs) |
| 30 | (error "nxml-mode is not compatible with Mule-UCS")) |
| 31 | |
| 32 | (eval-when-compile (require 'cl-lib)) |
| 33 | |
| 34 | (require 'xmltok) |
| 35 | (require 'nxml-enc) |
| 36 | (require 'nxml-glyph) |
| 37 | (require 'nxml-util) |
| 38 | (require 'nxml-rap) |
| 39 | (require 'nxml-outln) |
| 40 | ;; nxml-mode calls rng-nxml-mode-init, which is autoloaded from rng-nxml. |
| 41 | ;; So we might as well just require it and silence the compiler. |
| 42 | (provide 'nxml-mode) ; avoid recursive require |
| 43 | (require 'rng-nxml) |
| 44 | |
| 45 | ;;; Customization |
| 46 | |
| 47 | (defgroup nxml nil |
| 48 | "New XML editing mode." |
| 49 | :link '(custom-manual "(nxml-mode) Top") |
| 50 | :group 'languages) |
| 51 | |
| 52 | (defgroup nxml-faces nil |
| 53 | "Faces for XML syntax highlighting." |
| 54 | :group 'nxml) |
| 55 | |
| 56 | (defcustom nxml-char-ref-display-glyph-flag t |
| 57 | "Non-nil means display glyph following character reference. |
| 58 | The glyph is displayed in face `nxml-glyph'. The abnormal hook |
| 59 | `nxml-glyph-set-functions' can be used to change the characters |
| 60 | for which glyphs are displayed." |
| 61 | :group 'nxml |
| 62 | :type 'boolean) |
| 63 | |
| 64 | (defcustom nxml-sexp-element-flag nil |
| 65 | "Non-nil means sexp commands treat an element as a single expression." |
| 66 | :group 'nxml |
| 67 | :type 'boolean) |
| 68 | |
| 69 | (defcustom nxml-slash-auto-complete-flag nil |
| 70 | "Non-nil means typing a slash automatically completes the end-tag. |
| 71 | This is used by `nxml-electric-slash'." |
| 72 | :group 'nxml |
| 73 | :type 'boolean) |
| 74 | |
| 75 | (defcustom nxml-child-indent 2 |
| 76 | "Indentation for the children of an element relative to the start-tag. |
| 77 | This only applies when the line or lines containing the start-tag contains |
| 78 | nothing else other than that start-tag." |
| 79 | :group 'nxml |
| 80 | :type 'integer) |
| 81 | |
| 82 | (defcustom nxml-attribute-indent 4 |
| 83 | "Indentation for the attributes of an element relative to the start-tag. |
| 84 | This only applies when the first attribute of a tag starts a line. |
| 85 | In other cases, the first attribute on one line is indented the same |
| 86 | as the first attribute on the previous line." |
| 87 | :group 'nxml |
| 88 | :type 'integer) |
| 89 | |
| 90 | (defcustom nxml-bind-meta-tab-to-complete-flag t |
| 91 | "Non-nil means to use nXML completion in \\[completion-at-point]." |
| 92 | :group 'nxml |
| 93 | :type 'boolean) |
| 94 | |
| 95 | (defcustom nxml-prefer-utf-16-to-utf-8-flag nil |
| 96 | "Non-nil means prefer UTF-16 to UTF-8 when saving a buffer. |
| 97 | This is used only when a buffer does not contain an encoding declaration |
| 98 | and when its current `buffer-file-coding-system' specifies neither UTF-16 |
| 99 | nor UTF-8." |
| 100 | :group 'nxml |
| 101 | :type 'boolean) |
| 102 | |
| 103 | (defcustom nxml-prefer-utf-16-little-to-big-endian-flag (eq system-type |
| 104 | 'windows-nt) |
| 105 | "Non-nil means prefer little-endian to big-endian byte-order for UTF-16. |
| 106 | This is used only for saving a buffer; when reading the byte-order is |
| 107 | auto-detected. It may be relevant both when there is no encoding declaration |
| 108 | and when the encoding declaration specifies `UTF-16'." |
| 109 | :group 'nxml |
| 110 | :type 'boolean) |
| 111 | |
| 112 | (defcustom nxml-default-buffer-file-coding-system nil |
| 113 | "Default value for `buffer-file-coding-system' for a buffer for a new file. |
| 114 | A value of nil means use the default value of `buffer-file-coding-system' as normal. |
| 115 | A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts." |
| 116 | :group 'nxml |
| 117 | :type 'coding-system) |
| 118 | |
| 119 | (defcustom nxml-auto-insert-xml-declaration-flag nil |
| 120 | "Non-nil means automatically insert an XML declaration in a new file. |
| 121 | The XML declaration is inserted using `nxml-insert-xml-declaration'." |
| 122 | :group 'nxml |
| 123 | :type 'boolean) |
| 124 | |
| 125 | (defface nxml-delimited-data |
| 126 | '((t (:inherit font-lock-doc-face))) |
| 127 | "Face used to highlight data enclosed between delimiters. |
| 128 | This is not used directly, but only via inheritance by other faces." |
| 129 | :group 'nxml-faces) |
| 130 | |
| 131 | (defface nxml-name |
| 132 | '((t (:inherit font-lock-builtin-face))) |
| 133 | "Face used to highlight various names. |
| 134 | This includes element and attribute names, processing |
| 135 | instruction targets and the CDATA keyword in a CDATA section. |
| 136 | This is not used directly, but only via inheritance by other faces." |
| 137 | :group 'nxml-faces) |
| 138 | |
| 139 | (defface nxml-ref |
| 140 | '((t (:inherit font-lock-constant-face))) |
| 141 | "Face used to highlight character and entity references. |
| 142 | This is not used directly, but only via inheritance by other faces." |
| 143 | :group 'nxml-faces) |
| 144 | |
| 145 | (defface nxml-delimiter |
| 146 | nil |
| 147 | "Face used to highlight delimiters. |
| 148 | This is not used directly, but only via inheritance by other faces." |
| 149 | :group 'nxml-faces) |
| 150 | |
| 151 | (defface nxml-text |
| 152 | nil |
| 153 | "Face used to highlight text." |
| 154 | :group 'nxml-faces) |
| 155 | |
| 156 | (defface nxml-comment-content |
| 157 | '((t (:inherit font-lock-comment-face))) |
| 158 | "Face used to highlight the content of comments." |
| 159 | :group 'nxml-faces) |
| 160 | |
| 161 | (defface nxml-comment-delimiter |
| 162 | '((t (:inherit font-lock-comment-delimiter-face))) |
| 163 | "Face used for the delimiters of comments, i.e., <!-- and -->." |
| 164 | :group 'nxml-faces) |
| 165 | |
| 166 | (defface nxml-processing-instruction-delimiter |
| 167 | '((t (:inherit nxml-delimiter))) |
| 168 | "Face used for the delimiters of processing instructions, i.e., <? and ?>." |
| 169 | :group 'nxml-faces) |
| 170 | |
| 171 | (defface nxml-processing-instruction-target |
| 172 | '((t (:inherit font-lock-keyword-face))) |
| 173 | "Face used for the target of processing instructions." |
| 174 | :group 'nxml-faces) |
| 175 | |
| 176 | (defface nxml-processing-instruction-content |
| 177 | '((t (:inherit nxml-delimited-data))) |
| 178 | "Face used for the content of processing instructions." |
| 179 | :group 'nxml-faces) |
| 180 | |
| 181 | (defface nxml-cdata-section-delimiter |
| 182 | '((t (:inherit nxml-delimiter))) |
| 183 | "Face used for the delimiters of CDATA sections, i.e., <![, [, and ]]>." |
| 184 | :group 'nxml-faces) |
| 185 | |
| 186 | (defface nxml-cdata-section-CDATA |
| 187 | '((t (:inherit nxml-name))) |
| 188 | "Face used for the CDATA keyword in CDATA sections." |
| 189 | :group 'nxml-faces) |
| 190 | |
| 191 | (defface nxml-cdata-section-content |
| 192 | '((t (:inherit nxml-text))) |
| 193 | "Face used for the content of CDATA sections." |
| 194 | :group 'nxml-faces) |
| 195 | |
| 196 | (defface nxml-char-ref-number |
| 197 | '((t (:inherit nxml-ref))) |
| 198 | "Face used for the number in character references. |
| 199 | This includes ths `x' in hex references." |
| 200 | :group 'nxml-faces) |
| 201 | |
| 202 | (defface nxml-char-ref-delimiter |
| 203 | '((t (:inherit nxml-ref))) |
| 204 | "Face used for the delimiters of character references, i.e., &# and ;." |
| 205 | :group 'nxml-faces) |
| 206 | |
| 207 | (defface nxml-entity-ref-name |
| 208 | '((t (:inherit nxml-ref))) |
| 209 | "Face used for the entity name in general entity references." |
| 210 | :group 'nxml-faces) |
| 211 | |
| 212 | (defface nxml-entity-ref-delimiter |
| 213 | '((t (:inherit nxml-ref))) |
| 214 | "Face used for the delimiters of entity references, i.e., & and ;." |
| 215 | :group 'nxml-faces) |
| 216 | |
| 217 | (defface nxml-tag-delimiter |
| 218 | '((t (:inherit nxml-delimiter))) |
| 219 | "Face used for the angle brackets delimiting tags. |
| 220 | `nxml-tag-slash' is used for slashes." |
| 221 | :group 'nxml-faces) |
| 222 | |
| 223 | (defface nxml-tag-slash |
| 224 | '((t (:inherit nxml-tag-delimiter))) |
| 225 | "Face used for slashes in tags, both in end-tags and empty-elements." |
| 226 | :group 'nxml-faces) |
| 227 | |
| 228 | (defface nxml-element-prefix |
| 229 | '((t (:inherit nxml-name))) |
| 230 | "Face used for the prefix of elements." |
| 231 | :group 'nxml-faces) |
| 232 | |
| 233 | (defface nxml-element-colon |
| 234 | nil |
| 235 | "Face used for the colon in element names." |
| 236 | :group 'nxml-faces) |
| 237 | |
| 238 | (defface nxml-element-local-name |
| 239 | '((t (:inherit font-lock-function-name-face))) |
| 240 | "Face used for the local name of elements." |
| 241 | :group 'nxml-faces) |
| 242 | |
| 243 | (defface nxml-attribute-prefix |
| 244 | '((t (:inherit nxml-name))) |
| 245 | "Face used for the prefix of attributes." |
| 246 | :group 'nxml-faces) |
| 247 | |
| 248 | (defface nxml-attribute-colon |
| 249 | '((t (:inherit nxml-delimiter))) |
| 250 | "Face used for the colon in attribute names." |
| 251 | :group 'nxml-faces) |
| 252 | |
| 253 | (defface nxml-attribute-local-name |
| 254 | '((t (:inherit font-lock-variable-name-face))) |
| 255 | "Face used for the local name of attributes." |
| 256 | :group 'nxml-faces) |
| 257 | |
| 258 | (defface nxml-namespace-attribute-xmlns |
| 259 | '((t (:inherit nxml-attribute-prefix))) |
| 260 | "Face used for `xmlns' in namespace attributes." |
| 261 | :group 'nxml-faces) |
| 262 | |
| 263 | (defface nxml-namespace-attribute-colon |
| 264 | '((t (:inherit nxml-attribute-colon))) |
| 265 | "Face used for the colon in namespace attributes." |
| 266 | :group 'nxml-faces) |
| 267 | |
| 268 | (defface nxml-namespace-attribute-prefix |
| 269 | '((t (:inherit nxml-attribute-local-name))) |
| 270 | "Face used for the prefix declared in namespace attributes." |
| 271 | :group 'nxml-faces) |
| 272 | |
| 273 | (defface nxml-attribute-value |
| 274 | '((t (:inherit font-lock-string-face))) |
| 275 | "Face used for the value of attributes." |
| 276 | :group 'nxml-faces) |
| 277 | |
| 278 | (defface nxml-attribute-value-delimiter |
| 279 | '((t (:inherit nxml-attribute-value))) |
| 280 | "Face used for the delimiters of attribute values." |
| 281 | :group 'nxml-faces) |
| 282 | |
| 283 | (defface nxml-namespace-attribute-value |
| 284 | '((t (:inherit nxml-attribute-value))) |
| 285 | "Face used for the value of namespace attributes." |
| 286 | :group 'nxml-faces) |
| 287 | |
| 288 | (defface nxml-namespace-attribute-value-delimiter |
| 289 | '((t (:inherit nxml-attribute-value-delimiter))) |
| 290 | "Face used for the delimiters of namespace attribute values." |
| 291 | :group 'nxml-faces) |
| 292 | |
| 293 | (defface nxml-prolog-literal-delimiter |
| 294 | '((t (:inherit nxml-delimited-data))) |
| 295 | "Face used for the delimiters of literals in the prolog." |
| 296 | :group 'nxml-faces) |
| 297 | |
| 298 | (defface nxml-prolog-literal-content |
| 299 | '((t (:inherit nxml-delimited-data))) |
| 300 | "Face used for the content of literals in the prolog." |
| 301 | :group 'nxml-faces) |
| 302 | |
| 303 | (defface nxml-prolog-keyword |
| 304 | '((t (:inherit font-lock-keyword-face))) |
| 305 | "Face used for keywords in the prolog." |
| 306 | :group 'nxml-faces) |
| 307 | |
| 308 | (defface nxml-markup-declaration-delimiter |
| 309 | '((t (:inherit nxml-delimiter))) |
| 310 | "Face used for the delimiters of markup declarations in the prolog. |
| 311 | The delimiters are <! and >." |
| 312 | :group 'nxml-faces) |
| 313 | |
| 314 | (defface nxml-hash |
| 315 | '((t (:inherit nxml-name))) |
| 316 | "Face used for # before a name in the prolog." |
| 317 | :group 'nxml-faces) |
| 318 | |
| 319 | (defface nxml-glyph |
| 320 | '((((type x)) |
| 321 | (:family |
| 322 | "misc-fixed" |
| 323 | :background |
| 324 | "light grey" |
| 325 | :foreground |
| 326 | "black" |
| 327 | :weight |
| 328 | normal |
| 329 | :slant |
| 330 | normal)) |
| 331 | (t |
| 332 | (:background |
| 333 | "light grey" |
| 334 | :foreground |
| 335 | "black" |
| 336 | :weight |
| 337 | normal |
| 338 | :slant |
| 339 | normal))) |
| 340 | "Face used for glyph for char references." |
| 341 | :group 'nxml-faces) |
| 342 | |
| 343 | ;;; Global variables |
| 344 | |
| 345 | (defvar nxml-parent-document nil |
| 346 | "The parent document for a part of a modular document. |
| 347 | Use `nxml-parent-document-set' to set it.") |
| 348 | (make-variable-buffer-local 'nxml-parent-document) |
| 349 | (put 'nxml-parent-document 'safe-local-variable 'stringp) |
| 350 | |
| 351 | (defvar nxml-prolog-regions nil |
| 352 | "List of regions in the prolog to be fontified. |
| 353 | See the function `xmltok-forward-prolog' for more information.") |
| 354 | (make-variable-buffer-local 'nxml-prolog-regions) |
| 355 | |
| 356 | (defvar nxml-degraded nil |
| 357 | "Non-nil if currently operating in degraded mode. |
| 358 | Degraded mode is enabled when an internal error is encountered in the |
| 359 | fontification or after-change functions.") |
| 360 | (make-variable-buffer-local 'nxml-degraded) |
| 361 | |
| 362 | (defvar nxml-completion-hook nil |
| 363 | "Hook run by `nxml-complete'. |
| 364 | This hook is run until success.") |
| 365 | |
| 366 | (defvar nxml-in-mixed-content-hook nil |
| 367 | "Hook to determine whether point is in mixed content. |
| 368 | The hook is called without arguments. It should return nil if it is |
| 369 | definitely not mixed; non-nil otherwise. The hook will be run until |
| 370 | one of the functions returns nil.") |
| 371 | |
| 372 | (defvar nxml-mixed-scan-distance 4000 |
| 373 | "Maximum distance from point to scan when checking for mixed content.") |
| 374 | |
| 375 | (defvar nxml-end-tag-indent-scan-distance 4000 |
| 376 | "Maximum distance from point to scan backwards when indenting end-tag.") |
| 377 | |
| 378 | (defvar nxml-char-ref-extra-display t |
| 379 | "Non-nil means display extra information for character references. |
| 380 | The extra information consists of a tooltip with the character name |
| 381 | and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph |
| 382 | corresponding to the referenced character following the character |
| 383 | reference.") |
| 384 | (make-variable-buffer-local 'nxml-char-ref-extra-display) |
| 385 | |
| 386 | (defvar nxml-mode-map |
| 387 | (let ((map (make-sparse-keymap))) |
| 388 | (define-key map "\M-\C-u" 'nxml-backward-up-element) |
| 389 | (define-key map "\M-\C-d" 'nxml-down-element) |
| 390 | (define-key map "\M-\C-n" 'nxml-forward-element) |
| 391 | (define-key map "\M-\C-p" 'nxml-backward-element) |
| 392 | (define-key map "\M-{" 'nxml-backward-paragraph) |
| 393 | (define-key map "\M-}" 'nxml-forward-paragraph) |
| 394 | (define-key map "\M-h" 'nxml-mark-paragraph) |
| 395 | (define-key map "\C-c\C-f" 'nxml-finish-element) |
| 396 | (define-key map "\C-c]" 'nxml-finish-element) |
| 397 | (define-key map "\C-c/" 'nxml-finish-element) |
| 398 | (define-key map "\C-c\C-m" 'nxml-split-element) |
| 399 | (define-key map "\C-c\C-b" 'nxml-balanced-close-start-tag-block) |
| 400 | (define-key map "\C-c\C-i" 'nxml-balanced-close-start-tag-inline) |
| 401 | (define-key map "\C-c\C-x" 'nxml-insert-xml-declaration) |
| 402 | (define-key map "\C-c\C-d" 'nxml-dynamic-markup-word) |
| 403 | ;; u is for Unicode |
| 404 | (define-key map "\C-c\C-u" 'nxml-insert-named-char) |
| 405 | (define-key map "\C-c\C-o" nxml-outline-prefix-map) |
| 406 | (define-key map [S-mouse-2] 'nxml-mouse-hide-direct-text-content) |
| 407 | (define-key map "/" 'nxml-electric-slash) |
| 408 | (define-key map "\M-\t" 'completion-at-point) |
| 409 | map) |
| 410 | "Keymap for nxml-mode.") |
| 411 | |
| 412 | (defvar nxml-font-lock-keywords |
| 413 | '(nxml-fontify-matcher) |
| 414 | "Default font lock keywords for nxml-mode.") |
| 415 | |
| 416 | (defsubst nxml-set-face (start end face) |
| 417 | (when (and face (< start end)) |
| 418 | (font-lock-append-text-property start end 'face face))) |
| 419 | |
| 420 | (defun nxml-parent-document-set (parent-document) |
| 421 | "Set `nxml-parent-document' and inherit the DTD &c." |
| 422 | ;; FIXME: this does not work. |
| 423 | ;; the idea is that by inheriting some variables from the parent, |
| 424 | ;; `rng-validate-mode' will validate entities declared in the parent. |
| 425 | ;; alas, the most interesting variables (`rng-compile-table' et al) |
| 426 | ;; are circular and cannot be printed even with `print-circle'. |
| 427 | (interactive "fParent document") |
| 428 | (let (dtd current-schema current-schema-file-name compile-table |
| 429 | ipattern-table last-ipattern-index) |
| 430 | (when (string= (file-truename parent-document) |
| 431 | (file-truename buffer-file-name)) |
| 432 | (error "Parent document cannot be the same as the document")) |
| 433 | (with-current-buffer (find-file-noselect parent-document) |
| 434 | (setq dtd rng-dtd |
| 435 | current-schema rng-current-schema |
| 436 | current-schema-file-name rng-current-schema-file-name |
| 437 | compile-table rng-compile-table |
| 438 | ipattern-table rng-ipattern-table |
| 439 | last-ipattern-index rng-last-ipattern-index |
| 440 | parent-document buffer-file-name)) |
| 441 | (setq rng-dtd dtd |
| 442 | rng-current-schema current-schema |
| 443 | rng-current-schema-file-name current-schema-file-name |
| 444 | rng-compile-table compile-table |
| 445 | rng-ipattern-table ipattern-table |
| 446 | rng-last-ipattern-index last-ipattern-index |
| 447 | nxml-parent-document parent-document) |
| 448 | (message "Set parent document to %s" parent-document) |
| 449 | (when rng-validate-mode |
| 450 | (rng-validate-while-idle (current-buffer))))) |
| 451 | |
| 452 | ;;;###autoload |
| 453 | (define-derived-mode nxml-mode text-mode "nXML" |
| 454 | ;; We use C-c C-i instead of \\[nxml-balanced-close-start-tag-inline] |
| 455 | ;; because Emacs turns C-c C-i into C-c TAB which is hard to type and |
| 456 | ;; not mnemonic. |
| 457 | "Major mode for editing XML. |
| 458 | |
| 459 | \\[nxml-finish-element] finishes the current element by inserting an end-tag. |
| 460 | C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag |
| 461 | leaving point between the start-tag and end-tag. |
| 462 | \\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements: |
| 463 | the start-tag, point, and end-tag are all left on separate lines. |
| 464 | If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</' |
| 465 | automatically inserts the rest of the end-tag. |
| 466 | |
| 467 | \\[completion-at-point] performs completion on the symbol preceding point. |
| 468 | |
| 469 | \\[nxml-dynamic-markup-word] uses the contents of the current buffer |
| 470 | to choose a tag to put around the word preceding point. |
| 471 | |
| 472 | Sections of the document can be displayed in outline form. The |
| 473 | variable `nxml-section-element-name-regexp' controls when an element |
| 474 | is recognized as a section. The same key sequences that change |
| 475 | visibility in outline mode are used except that they start with C-c C-o |
| 476 | instead of C-c. |
| 477 | |
| 478 | Validation is provided by the related minor-mode `rng-validate-mode'. |
| 479 | This also makes completion schema- and context- sensitive. Element |
| 480 | names, attribute names, attribute values and namespace URIs can all be |
| 481 | completed. By default, `rng-validate-mode' is automatically enabled. |
| 482 | You can toggle it using \\[rng-validate-mode] or change the default by |
| 483 | customizing `rng-nxml-auto-validate-flag'. |
| 484 | |
| 485 | \\[indent-for-tab-command] indents the current line appropriately. |
| 486 | This can be customized using the variable `nxml-child-indent' |
| 487 | and the variable `nxml-attribute-indent'. |
| 488 | |
| 489 | \\[nxml-insert-named-char] inserts a character reference using |
| 490 | the character's name (by default, the Unicode name). |
| 491 | \\[universal-argument] \\[nxml-insert-named-char] inserts the character directly. |
| 492 | |
| 493 | The Emacs commands that normally operate on balanced expressions will |
| 494 | operate on XML markup items. Thus \\[forward-sexp] will move forward |
| 495 | across one markup item; \\[backward-sexp] will move backward across |
| 496 | one markup item; \\[kill-sexp] will kill the following markup item; |
| 497 | \\[mark-sexp] will mark the following markup item. By default, each |
| 498 | tag each treated as a single markup item; to make the complete element |
| 499 | be treated as a single markup item, set the variable |
| 500 | `nxml-sexp-element-flag' to t. For more details, see the function |
| 501 | `nxml-forward-balanced-item'. |
| 502 | |
| 503 | \\[nxml-backward-up-element] and \\[nxml-down-element] move up and down the element structure. |
| 504 | |
| 505 | Many aspects this mode can be customized using |
| 506 | \\[customize-group] nxml RET." |
| 507 | ;; (kill-all-local-variables) |
| 508 | (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) |
| 509 | ;; We'll determine the fill prefix ourselves |
| 510 | (make-local-variable 'adaptive-fill-mode) |
| 511 | (setq adaptive-fill-mode nil) |
| 512 | (make-local-variable 'forward-sexp-function) |
| 513 | (setq forward-sexp-function 'nxml-forward-balanced-item) |
| 514 | (make-local-variable 'indent-line-function) |
| 515 | (setq indent-line-function 'nxml-indent-line) |
| 516 | (make-local-variable 'fill-paragraph-function) |
| 517 | (setq fill-paragraph-function 'nxml-do-fill-paragraph) |
| 518 | ;; Comment support |
| 519 | ;; This doesn't seem to work too well; |
| 520 | ;; I think we should probably roll our own nxml-comment-dwim function. |
| 521 | (make-local-variable 'comment-indent-function) |
| 522 | (setq comment-indent-function 'nxml-indent-line) |
| 523 | (make-local-variable 'comment-start) |
| 524 | (setq comment-start "<!--") |
| 525 | (make-local-variable 'comment-start-skip) |
| 526 | (setq comment-start-skip "<!--[ \t\r\n]*") |
| 527 | (make-local-variable 'comment-end) |
| 528 | (setq comment-end "-->") |
| 529 | (make-local-variable 'comment-end-skip) |
| 530 | (setq comment-end-skip "[ \t\r\n]*-->") |
| 531 | (make-local-variable 'comment-line-break-function) |
| 532 | (setq comment-line-break-function 'nxml-newline-and-indent) |
| 533 | (use-local-map nxml-mode-map) |
| 534 | (save-excursion |
| 535 | (save-restriction |
| 536 | (widen) |
| 537 | (setq nxml-scan-end (copy-marker (point-min) nil)) |
| 538 | (with-silent-modifications |
| 539 | (nxml-clear-inside (point-min) (point-max)) |
| 540 | (nxml-with-invisible-motion |
| 541 | (nxml-scan-prolog))))) |
| 542 | (add-hook 'completion-at-point-functions |
| 543 | #'nxml-completion-at-point-function nil t) |
| 544 | (setq-local syntax-propertize-function #'nxml-after-change) |
| 545 | (add-hook 'change-major-mode-hook 'nxml-cleanup nil t) |
| 546 | |
| 547 | ;; Emacs 23 handles the encoding attribute on the xml declaration |
| 548 | ;; transparently to nxml-mode, so there is no longer a need for the below |
| 549 | ;; hook. The hook also had the drawback of overriding explicit user |
| 550 | ;; instruction to save as some encoding other than utf-8. |
| 551 | ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save) |
| 552 | (when (not (and (buffer-file-name) (file-exists-p (buffer-file-name)))) |
| 553 | (when (and nxml-default-buffer-file-coding-system |
| 554 | (not (local-variable-p 'buffer-file-coding-system))) |
| 555 | (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) |
| 556 | (when nxml-auto-insert-xml-declaration-flag |
| 557 | (nxml-insert-xml-declaration))) |
| 558 | |
| 559 | (setq font-lock-defaults |
| 560 | '(nxml-font-lock-keywords |
| 561 | t ; keywords-only; we highlight comments and strings here |
| 562 | nil ; font-lock-keywords-case-fold-search. XML is case sensitive |
| 563 | nil ; no special syntax table |
| 564 | nil ; no automatic syntactic fontification |
| 565 | (font-lock-extend-region-functions . (nxml-extend-region)) |
| 566 | (jit-lock-contextually . t) |
| 567 | (font-lock-unfontify-region-function . nxml-unfontify-region))) |
| 568 | |
| 569 | (rng-nxml-mode-init) |
| 570 | (nxml-enable-unicode-char-name-sets)) |
| 571 | |
| 572 | (defun nxml-cleanup () |
| 573 | "Clean up after nxml-mode." |
| 574 | ;; Disable associated minor modes. |
| 575 | (rng-validate-mode -1) |
| 576 | ;; Clean up fontification. |
| 577 | (save-excursion |
| 578 | (widen) |
| 579 | (with-silent-modifications |
| 580 | (nxml-with-invisible-motion |
| 581 | (remove-text-properties (point-min) (point-max) '(face))))) |
| 582 | (remove-hook 'change-major-mode-hook 'nxml-cleanup t)) |
| 583 | |
| 584 | (defun nxml-degrade (context err) |
| 585 | (message "Internal nXML mode error in %s (%s), degrading" |
| 586 | context |
| 587 | (error-message-string err)) |
| 588 | (ding) |
| 589 | (setq nxml-degraded t) |
| 590 | (setq nxml-prolog-end 1) |
| 591 | (save-excursion |
| 592 | (save-restriction |
| 593 | (widen) |
| 594 | (with-silent-modifications |
| 595 | (nxml-clear-inside (point-min) (point-max)))))) |
| 596 | |
| 597 | ;;; Change management |
| 598 | |
| 599 | (defvar font-lock-beg) (defvar font-lock-end) |
| 600 | (defun nxml-debug-region (start end) |
| 601 | (interactive "r") |
| 602 | (let ((font-lock-beg start) |
| 603 | (font-lock-end end)) |
| 604 | (nxml-extend-region) |
| 605 | (goto-char font-lock-beg) |
| 606 | (set-mark font-lock-end))) |
| 607 | |
| 608 | (defun nxml-after-change (start end) |
| 609 | ;; Called via syntax-propertize-function. |
| 610 | (unless nxml-degraded |
| 611 | (nxml-with-degradation-on-error 'nxml-after-change |
| 612 | (save-restriction |
| 613 | (widen) |
| 614 | (nxml-with-invisible-motion |
| 615 | (nxml-after-change1 start end)))))) |
| 616 | |
| 617 | (defun nxml-after-change1 (start end) |
| 618 | "After-change bookkeeping. |
| 619 | Returns a cons cell containing a possibly-enlarged change region. |
| 620 | You must call `nxml-extend-region' on this expanded region to obtain |
| 621 | the full extent of the area needing refontification. |
| 622 | |
| 623 | For bookkeeping, call this function even when fontification is |
| 624 | disabled." |
| 625 | ;; If the prolog might have changed, rescan the prolog. |
| 626 | (when (<= start |
| 627 | ;; Add 2 so as to include the < and following char that |
| 628 | ;; start the instance (document element), since changing |
| 629 | ;; these can change where the prolog ends. |
| 630 | (+ nxml-prolog-end 2)) |
| 631 | (nxml-scan-prolog) |
| 632 | (setq start (point-min))) |
| 633 | |
| 634 | (when (> end nxml-prolog-end) |
| 635 | (goto-char start) |
| 636 | (nxml-move-tag-backwards (point-min)) |
| 637 | (setq start (point)) |
| 638 | (setq end (max (nxml-scan-after-change start end) |
| 639 | end))) |
| 640 | |
| 641 | (nxml-debug-change "nxml-after-change1" start end)) |
| 642 | |
| 643 | ;;; Encodings |
| 644 | |
| 645 | (defun nxml-insert-xml-declaration () |
| 646 | "Insert an XML declaration at the beginning of buffer. |
| 647 | The XML declaration will declare an encoding depending on the buffer's |
| 648 | `buffer-file-coding-system'." |
| 649 | (interactive "*") |
| 650 | (let ((coding-system |
| 651 | (if (and buffer-file-coding-system |
| 652 | (coding-system-p buffer-file-coding-system) |
| 653 | (coding-system-get buffer-file-coding-system |
| 654 | 'mime-charset)) |
| 655 | buffer-file-coding-system |
| 656 | (nxml-choose-utf-coding-system)))) |
| 657 | (goto-char (point-min)) |
| 658 | (insert (format "<?xml version=\"1.0\" encoding=\"%s\"?>\n" |
| 659 | (nxml-coding-system-name coding-system))))) |
| 660 | |
| 661 | (defun nxml-prepare-to-save () |
| 662 | (unless (and (not enable-multibyte-characters) |
| 663 | (local-variable-p 'buffer-file-coding-system) |
| 664 | buffer-file-coding-system |
| 665 | (or (eq (coding-system-type buffer-file-coding-system) 5) |
| 666 | (eq buffer-file-coding-system 'no-conversion))) |
| 667 | (save-excursion |
| 668 | (setq buffer-file-coding-system (nxml-select-coding-system)))) |
| 669 | ;; nil from a function in `write-contents-hooks' means |
| 670 | ;; to continue and write the file as normal |
| 671 | nil) |
| 672 | |
| 673 | (defun nxml-select-coding-system () |
| 674 | (let* ((suitable-coding-systems |
| 675 | (find-coding-systems-region (point-min) (point-max))) |
| 676 | (enc-pos (progn |
| 677 | (goto-char (point-min)) |
| 678 | (xmltok-get-declared-encoding-position))) |
| 679 | (enc-name |
| 680 | (and (consp enc-pos) |
| 681 | (buffer-substring-no-properties (car enc-pos) |
| 682 | (cdr enc-pos)))) |
| 683 | (coding-system |
| 684 | (cond (enc-name |
| 685 | (if (string= (downcase enc-name) "utf-16") |
| 686 | (nxml-choose-utf-16-coding-system) |
| 687 | (nxml-mime-charset-coding-system enc-name))) |
| 688 | (enc-pos (nxml-choose-utf-coding-system))))) |
| 689 | ;; Make sure we have a coding-system |
| 690 | (unless coding-system |
| 691 | (setq coding-system |
| 692 | (and (not buffer-read-only) |
| 693 | (nxml-choose-suitable-coding-system |
| 694 | suitable-coding-systems))) |
| 695 | (let ((message |
| 696 | (if enc-name |
| 697 | (format "Unknown encoding %s" enc-name) |
| 698 | "XML declaration is not well-formed"))) |
| 699 | (cond ((not coding-system) |
| 700 | (error "%s" message)) |
| 701 | ((y-or-n-p |
| 702 | (concat message |
| 703 | ". " |
| 704 | (format (if enc-name |
| 705 | "Save with %s" |
| 706 | "Modify and save with encoding %s") |
| 707 | (nxml-coding-system-name coding-system)) |
| 708 | " ")) |
| 709 | (nxml-fix-encoding-declaration enc-pos coding-system)) |
| 710 | (t (signal 'quit nil))))) |
| 711 | ;; Make sure it can encode all the characters in the buffer |
| 712 | (unless (or (memq (coding-system-base coding-system) |
| 713 | suitable-coding-systems) |
| 714 | (equal suitable-coding-systems '(undecided))) |
| 715 | (let ((message |
| 716 | (nxml-unsuitable-coding-system-message coding-system |
| 717 | enc-name))) |
| 718 | (setq coding-system |
| 719 | (and (not buffer-read-only) |
| 720 | (nxml-choose-suitable-coding-system |
| 721 | suitable-coding-systems))) |
| 722 | (cond ((not coding-system) (error "%s" message)) |
| 723 | ((y-or-n-p (concat message |
| 724 | (format ". Save with %s " |
| 725 | (nxml-coding-system-name |
| 726 | coding-system)))) |
| 727 | (nxml-fix-encoding-declaration enc-pos coding-system)) |
| 728 | (t (signal 'quit nil))))) |
| 729 | ;; Merge the newline type of our existing encoding |
| 730 | (let ((current-eol-type |
| 731 | (coding-system-eol-type buffer-file-coding-system))) |
| 732 | (when (and current-eol-type (integerp current-eol-type)) |
| 733 | (setq coding-system |
| 734 | (coding-system-change-eol-conversion coding-system |
| 735 | current-eol-type)))) |
| 736 | coding-system)) |
| 737 | |
| 738 | (defun nxml-unsuitable-coding-system-message (coding-system &optional enc-name) |
| 739 | (if (nxml-coding-system-unicode-p coding-system) |
| 740 | "Cannot translate some characters to Unicode" |
| 741 | (format "Cannot encode some characters with %s" |
| 742 | (or enc-name |
| 743 | (nxml-coding-system-name coding-system))))) |
| 744 | |
| 745 | (defconst nxml-utf-16-coding-systems (and (coding-system-p 'utf-16-be) |
| 746 | (coding-system-p 'utf-16-le) |
| 747 | '(utf-16-be utf-16-le))) |
| 748 | |
| 749 | (defconst nxml-utf-coding-systems (cons 'utf-8 nxml-utf-16-coding-systems)) |
| 750 | |
| 751 | (defun nxml-coding-system-unicode-p (coding-system) |
| 752 | (nxml-coding-system-member (coding-system-base coding-system) |
| 753 | nxml-utf-coding-systems)) |
| 754 | |
| 755 | (defun nxml-coding-system-name (coding-system) |
| 756 | (setq coding-system (coding-system-base coding-system)) |
| 757 | (symbol-name |
| 758 | (if (nxml-coding-system-member coding-system nxml-utf-16-coding-systems) |
| 759 | 'utf-16 |
| 760 | (or (coding-system-get coding-system 'mime-charset) |
| 761 | coding-system)))) |
| 762 | |
| 763 | (defun nxml-fix-encoding-declaration (enc-pos coding-system) |
| 764 | (let ((charset (nxml-coding-system-name coding-system))) |
| 765 | (cond ((consp enc-pos) |
| 766 | (delete-region (car enc-pos) (cdr enc-pos)) |
| 767 | (goto-char (car enc-pos)) |
| 768 | (insert charset)) |
| 769 | ((integerp enc-pos) |
| 770 | (goto-char enc-pos) |
| 771 | (insert " encoding=\"" charset ?\")) |
| 772 | (t |
| 773 | (goto-char (point-min)) |
| 774 | (insert "<?xml version=\"1.0\" encoding=\"" |
| 775 | charset |
| 776 | "\"?>\n") |
| 777 | (when (and (not enc-pos) |
| 778 | (let ((case-fold-search t)) |
| 779 | (looking-at xmltok-bad-xml-decl-regexp))) |
| 780 | (delete-region (point) (match-end 0))))))) |
| 781 | |
| 782 | (defun nxml-choose-suitable-coding-system (suitable-coding-systems) |
| 783 | (let (ret coding-system) |
| 784 | (if (and buffer-file-coding-system |
| 785 | (memq (coding-system-base buffer-file-coding-system) |
| 786 | suitable-coding-systems)) |
| 787 | buffer-file-coding-system |
| 788 | (while (and suitable-coding-systems (not ret)) |
| 789 | (setq coding-system (car suitable-coding-systems)) |
| 790 | (if (coding-system-get coding-system 'mime-charset) |
| 791 | (setq ret coding-system) |
| 792 | (setq suitable-coding-systems (cdr suitable-coding-systems)))) |
| 793 | ret))) |
| 794 | |
| 795 | (defun nxml-choose-utf-coding-system () |
| 796 | (let ((cur (and (local-variable-p 'buffer-file-coding-system) |
| 797 | buffer-file-coding-system |
| 798 | (coding-system-base buffer-file-coding-system)))) |
| 799 | (cond ((car (nxml-coding-system-member cur nxml-utf-coding-systems))) |
| 800 | ((and nxml-prefer-utf-16-to-utf-8-flag |
| 801 | (coding-system-p 'utf-16-le) |
| 802 | (coding-system-p 'utf-16-be)) |
| 803 | (if nxml-prefer-utf-16-little-to-big-endian-flag |
| 804 | 'utf-16-le |
| 805 | 'utf-16-be)) |
| 806 | (t 'utf-8)))) |
| 807 | |
| 808 | (defun nxml-choose-utf-16-coding-system () |
| 809 | (let ((cur (and (local-variable-p 'buffer-file-coding-system) |
| 810 | buffer-file-coding-system |
| 811 | (coding-system-base buffer-file-coding-system)))) |
| 812 | (cond ((car (nxml-coding-system-member cur nxml-utf-16-coding-systems))) |
| 813 | (nxml-prefer-utf-16-little-to-big-endian-flag |
| 814 | (and (coding-system-p 'utf-16-le) 'utf-16-le)) |
| 815 | (t (and (coding-system-p 'utf-16-be) 'utf-16-be))))) |
| 816 | |
| 817 | (defun nxml-coding-system-member (coding-system coding-systems) |
| 818 | (let (ret) |
| 819 | (while (and coding-systems (not ret)) |
| 820 | (if (coding-system-equal coding-system |
| 821 | (car coding-systems)) |
| 822 | (setq ret coding-systems) |
| 823 | (setq coding-systems (cdr coding-systems)))) |
| 824 | ret)) |
| 825 | |
| 826 | ;;; Fontification |
| 827 | |
| 828 | (defun nxml-unfontify-region (start end) |
| 829 | (font-lock-default-unfontify-region start end) |
| 830 | (nxml-clear-char-ref-extra-display start end)) |
| 831 | |
| 832 | (defun nxml-extend-region () |
| 833 | "Extend the region to hold the minimum area we can fontify with nXML. |
| 834 | Called with `font-lock-beg' and `font-lock-end' dynamically bound." |
| 835 | (let ((start font-lock-beg) |
| 836 | (end font-lock-end)) |
| 837 | |
| 838 | (nxml-debug-change "nxml-extend-region(input)" start end) |
| 839 | |
| 840 | (when (< start nxml-prolog-end) |
| 841 | (setq start (point-min))) |
| 842 | |
| 843 | (cond ((<= end nxml-prolog-end) |
| 844 | (setq end nxml-prolog-end)) |
| 845 | |
| 846 | (t |
| 847 | (goto-char start) |
| 848 | ;; some font-lock backends (like Emacs 22 jit-lock) snap |
| 849 | ;; the region to the beginning of the line no matter what |
| 850 | ;; we say here. To mitigate the resulting excess |
| 851 | ;; fontification, ignore leading whitespace. |
| 852 | (skip-syntax-forward " ") |
| 853 | |
| 854 | ;; find the beginning of the previous tag |
| 855 | (when (not (equal (char-after) ?\<)) |
| 856 | (search-backward "<" nxml-prolog-end t)) |
| 857 | (nxml-ensure-scan-up-to-date) |
| 858 | (nxml-move-outside-backwards) |
| 859 | (setq start (point)) |
| 860 | |
| 861 | (while (< (point) end) |
| 862 | (nxml-tokenize-forward)) |
| 863 | |
| 864 | (setq end (point)))) |
| 865 | |
| 866 | (when (or (< start font-lock-beg) |
| 867 | (> end font-lock-end)) |
| 868 | (setq font-lock-beg start |
| 869 | font-lock-end end) |
| 870 | (nxml-debug-change "nxml-extend-region" start end) |
| 871 | t))) |
| 872 | |
| 873 | (defun nxml-fontify-matcher (bound) |
| 874 | "Called as font-lock keyword matcher." |
| 875 | (syntax-propertize bound) |
| 876 | (unless nxml-degraded |
| 877 | (nxml-debug-change "nxml-fontify-matcher" (point) bound) |
| 878 | |
| 879 | (when (< (point) nxml-prolog-end) |
| 880 | ;; Prolog needs to be fontified in one go, and |
| 881 | ;; nxml-extend-region makes sure we start at BOB. |
| 882 | (cl-assert (bobp)) |
| 883 | (nxml-fontify-prolog) |
| 884 | (goto-char nxml-prolog-end)) |
| 885 | |
| 886 | (let (xmltok-errors) |
| 887 | (while (and (nxml-tokenize-forward) |
| 888 | (<= (point) bound)) ; Intervals are open-ended. |
| 889 | (nxml-apply-fontify-rule))) |
| 890 | |
| 891 | ) |
| 892 | |
| 893 | ;; Since we did the fontification internally, tell font-lock to not |
| 894 | ;; do anything itself. |
| 895 | nil) |
| 896 | |
| 897 | (defun nxml-fontify-prolog () |
| 898 | "Fontify the prolog. |
| 899 | The buffer is assumed to be prepared for fontification. |
| 900 | This does not set the fontified property, but it does clear |
| 901 | faces appropriately." |
| 902 | (let ((regions nxml-prolog-regions)) |
| 903 | (while regions |
| 904 | (let ((region (car regions))) |
| 905 | (nxml-apply-fontify-rule (aref region 0) |
| 906 | (aref region 1) |
| 907 | (aref region 2))) |
| 908 | (setq regions (cdr regions))))) |
| 909 | |
| 910 | ;; Vectors identify a substring of the token to be highlighted in some face. |
| 911 | |
| 912 | ;; Token types returned by xmltok-forward. |
| 913 | |
| 914 | (put 'start-tag |
| 915 | 'nxml-fontify-rule |
| 916 | '([nil 1 nxml-tag-delimiter] |
| 917 | [-1 nil nxml-tag-delimiter] |
| 918 | (element-qname . 1) |
| 919 | attributes)) |
| 920 | |
| 921 | (put 'partial-start-tag |
| 922 | 'nxml-fontify-rule |
| 923 | '([nil 1 nxml-tag-delimiter] |
| 924 | (element-qname . 1) |
| 925 | attributes)) |
| 926 | |
| 927 | (put 'end-tag |
| 928 | 'nxml-fontify-rule |
| 929 | '([nil 1 nxml-tag-delimiter] |
| 930 | [1 2 nxml-tag-slash] |
| 931 | [-1 nil nxml-tag-delimiter] |
| 932 | (element-qname . 2))) |
| 933 | |
| 934 | (put 'partial-end-tag |
| 935 | 'nxml-fontify-rule |
| 936 | '([nil 1 nxml-tag-delimiter] |
| 937 | [1 2 nxml-tag-slash] |
| 938 | (element-qname . 2))) |
| 939 | |
| 940 | (put 'empty-element |
| 941 | 'nxml-fontify-rule |
| 942 | '([nil 1 nxml-tag-delimiter] |
| 943 | [-2 -1 nxml-tag-slash] |
| 944 | [-1 nil nxml-tag-delimiter] |
| 945 | (element-qname . 1) |
| 946 | attributes)) |
| 947 | |
| 948 | (put 'partial-empty-element |
| 949 | 'nxml-fontify-rule |
| 950 | '([nil 1 nxml-tag-delimiter] |
| 951 | [-1 nil nxml-tag-slash] |
| 952 | (element-qname . 1) |
| 953 | attributes)) |
| 954 | |
| 955 | (put 'char-ref |
| 956 | 'nxml-fontify-rule |
| 957 | '([nil 2 nxml-char-ref-delimiter] |
| 958 | [2 -1 nxml-char-ref-number] |
| 959 | [-1 nil nxml-char-ref-delimiter] |
| 960 | char-ref)) |
| 961 | |
| 962 | (put 'entity-ref |
| 963 | 'nxml-fontify-rule |
| 964 | '([nil 1 nxml-entity-ref-delimiter] |
| 965 | [1 -1 nxml-entity-ref-name] |
| 966 | [-1 nil nxml-entity-ref-delimiter])) |
| 967 | |
| 968 | (put 'comment |
| 969 | 'nxml-fontify-rule |
| 970 | '([nil 4 nxml-comment-delimiter] |
| 971 | [4 -3 nxml-comment-content] |
| 972 | [-3 nil nxml-comment-delimiter])) |
| 973 | |
| 974 | (put 'processing-instruction |
| 975 | 'nxml-fontify-rule |
| 976 | '([nil 2 nxml-processing-instruction-delimiter] |
| 977 | [-2 nil nxml-processing-instruction-delimiter] |
| 978 | processing-instruction-content)) |
| 979 | |
| 980 | (put 'cdata-section |
| 981 | 'nxml-fontify-rule |
| 982 | '([nil 3 nxml-cdata-section-delimiter] ; <![ |
| 983 | [3 8 nxml-cdata-section-CDATA] ; CDATA |
| 984 | [8 9 nxml-cdata-section-delimiter] ; [ |
| 985 | [9 -3 nxml-cdata-section-content] ; ]]> |
| 986 | [-3 nil nxml-cdata-section-delimiter])) |
| 987 | |
| 988 | (put 'data |
| 989 | 'nxml-fontify-rule |
| 990 | '([nil nil nxml-text])) |
| 991 | |
| 992 | ;; Prolog region types in list returned by xmltok-forward-prolog. |
| 993 | |
| 994 | (put 'xml-declaration |
| 995 | 'nxml-fontify-rule |
| 996 | '([nil 2 nxml-processing-instruction-delimiter] |
| 997 | [2 5 nxml-processing-instruction-target] |
| 998 | [-2 nil nxml-processing-instruction-delimiter])) |
| 999 | |
| 1000 | (put 'xml-declaration-attribute-name |
| 1001 | 'nxml-fontify-rule |
| 1002 | '([nil nil nxml-attribute-local-name])) |
| 1003 | |
| 1004 | (put 'xml-declaration-attribute-value |
| 1005 | 'nxml-fontify-rule |
| 1006 | '([nil 1 nxml-attribute-value-delimiter] |
| 1007 | [1 -1 nxml-attribute-value] |
| 1008 | [-1 nil nxml-attribute-value-delimiter])) |
| 1009 | |
| 1010 | (put 'processing-instruction-left |
| 1011 | 'nxml-fontify-rule |
| 1012 | '([nil 2 nxml-processing-instruction-delimiter] |
| 1013 | [2 nil nxml-processing-instruction-target])) |
| 1014 | |
| 1015 | (put 'processing-instruction-right |
| 1016 | 'nxml-fontify-rule |
| 1017 | '([nil -2 nxml-processing-instruction-content] |
| 1018 | [-2 nil nxml-processing-instruction-delimiter])) |
| 1019 | |
| 1020 | (put 'literal |
| 1021 | 'nxml-fontify-rule |
| 1022 | '([nil 1 nxml-prolog-literal-delimiter] |
| 1023 | [1 -1 nxml-prolog-literal-content] |
| 1024 | [-1 nil nxml-prolog-literal-delimiter])) |
| 1025 | |
| 1026 | (put 'keyword |
| 1027 | 'nxml-fontify-rule |
| 1028 | '([nil nil nxml-prolog-keyword])) |
| 1029 | |
| 1030 | (put 'markup-declaration-open |
| 1031 | 'nxml-fontify-rule |
| 1032 | '([0 2 nxml-markup-declaration-delimiter] |
| 1033 | [2 nil nxml-prolog-keyword])) |
| 1034 | |
| 1035 | (put 'markup-declaration-close |
| 1036 | 'nxml-fontify-rule |
| 1037 | '([nil nil nxml-markup-declaration-delimiter])) |
| 1038 | |
| 1039 | (put 'internal-subset-open |
| 1040 | 'nxml-fontify-rule |
| 1041 | '([nil nil nxml-markup-declaration-delimiter])) |
| 1042 | |
| 1043 | (put 'internal-subset-close |
| 1044 | 'nxml-fontify-rule |
| 1045 | '([nil 1 nxml-markup-declaration-delimiter] |
| 1046 | [-1 nil nxml-markup-declaration-delimiter])) |
| 1047 | |
| 1048 | (put 'hash-name |
| 1049 | 'nxml-fontify-rule |
| 1050 | '([nil 1 nxml-hash] |
| 1051 | [1 nil nxml-prolog-keyword])) |
| 1052 | |
| 1053 | (defun nxml-apply-fontify-rule (&optional type start end) |
| 1054 | (let ((rule (get (or type xmltok-type) 'nxml-fontify-rule))) |
| 1055 | (unless start (setq start xmltok-start)) |
| 1056 | (unless end (setq end (point))) |
| 1057 | (while rule |
| 1058 | (let* ((action (car rule))) |
| 1059 | (setq rule (cdr rule)) |
| 1060 | (cond ((vectorp action) |
| 1061 | (nxml-set-face (let ((offset (aref action 0))) |
| 1062 | (cond ((not offset) start) |
| 1063 | ((< offset 0) (+ end offset)) |
| 1064 | (t (+ start offset)))) |
| 1065 | (let ((offset (aref action 1))) |
| 1066 | (cond ((not offset) end) |
| 1067 | ((< offset 0) (+ end offset)) |
| 1068 | (t (+ start offset)))) |
| 1069 | (aref action 2))) |
| 1070 | ((and (consp action) |
| 1071 | (eq (car action) 'element-qname)) |
| 1072 | (when xmltok-name-end ; maybe nil in partial-end-tag case |
| 1073 | (nxml-fontify-qname (+ start (cdr action)) |
| 1074 | xmltok-name-colon |
| 1075 | xmltok-name-end |
| 1076 | 'nxml-element-prefix |
| 1077 | 'nxml-element-colon |
| 1078 | 'nxml-element-local-name))) |
| 1079 | ((eq action 'attributes) |
| 1080 | (nxml-fontify-attributes)) |
| 1081 | ((eq action 'processing-instruction-content) |
| 1082 | (nxml-set-face (+ start 2) |
| 1083 | xmltok-name-end |
| 1084 | 'nxml-processing-instruction-target) |
| 1085 | (nxml-set-face (save-excursion |
| 1086 | (goto-char xmltok-name-end) |
| 1087 | (skip-chars-forward " \t\r\n") |
| 1088 | (point)) |
| 1089 | (- end 2) |
| 1090 | 'nxml-processing-instruction-content)) |
| 1091 | ((eq action 'char-ref) |
| 1092 | (nxml-char-ref-display-extra start |
| 1093 | end |
| 1094 | (xmltok-char-number start end))) |
| 1095 | (t (error "Invalid nxml-fontify-rule action %s" action))))))) |
| 1096 | |
| 1097 | (defun nxml-fontify-attributes () |
| 1098 | (while xmltok-namespace-attributes |
| 1099 | (nxml-fontify-attribute (car xmltok-namespace-attributes) |
| 1100 | 'namespace) |
| 1101 | (setq xmltok-namespace-attributes |
| 1102 | (cdr xmltok-namespace-attributes))) |
| 1103 | (while xmltok-attributes |
| 1104 | (nxml-fontify-attribute (car xmltok-attributes)) |
| 1105 | (setq xmltok-attributes |
| 1106 | (cdr xmltok-attributes)))) |
| 1107 | |
| 1108 | (defun nxml-fontify-attribute (att &optional namespace-declaration) |
| 1109 | (if namespace-declaration |
| 1110 | (nxml-fontify-qname (xmltok-attribute-name-start att) |
| 1111 | (xmltok-attribute-name-colon att) |
| 1112 | (xmltok-attribute-name-end att) |
| 1113 | 'nxml-namespace-attribute-xmlns |
| 1114 | 'nxml-namespace-attribute-colon |
| 1115 | 'nxml-namespace-attribute-prefix |
| 1116 | 'nxml-namespace-attribute-xmlns) |
| 1117 | (nxml-fontify-qname (xmltok-attribute-name-start att) |
| 1118 | (xmltok-attribute-name-colon att) |
| 1119 | (xmltok-attribute-name-end att) |
| 1120 | 'nxml-attribute-prefix |
| 1121 | 'nxml-attribute-colon |
| 1122 | 'nxml-attribute-local-name)) |
| 1123 | (let ((start (xmltok-attribute-value-start att)) |
| 1124 | (end (xmltok-attribute-value-end att)) |
| 1125 | (refs (xmltok-attribute-refs att)) |
| 1126 | (delimiter-face (if namespace-declaration |
| 1127 | 'nxml-namespace-attribute-value-delimiter |
| 1128 | 'nxml-attribute-value-delimiter)) |
| 1129 | (value-face (if namespace-declaration |
| 1130 | 'nxml-namespace-attribute-value |
| 1131 | 'nxml-attribute-value))) |
| 1132 | (when start |
| 1133 | (nxml-set-face (1- start) start delimiter-face) |
| 1134 | (nxml-set-face end (1+ end) delimiter-face) |
| 1135 | (while refs |
| 1136 | (let* ((ref (car refs)) |
| 1137 | (ref-type (aref ref 0)) |
| 1138 | (ref-start (aref ref 1)) |
| 1139 | (ref-end (aref ref 2))) |
| 1140 | (nxml-set-face start ref-start value-face) |
| 1141 | (nxml-apply-fontify-rule ref-type ref-start ref-end) |
| 1142 | (setq start ref-end)) |
| 1143 | (setq refs (cdr refs))) |
| 1144 | (nxml-set-face start end value-face)))) |
| 1145 | |
| 1146 | (defun nxml-fontify-qname (start |
| 1147 | colon |
| 1148 | end |
| 1149 | prefix-face |
| 1150 | colon-face |
| 1151 | local-name-face |
| 1152 | &optional |
| 1153 | unprefixed-face) |
| 1154 | (cond (colon (nxml-set-face start colon prefix-face) |
| 1155 | (nxml-set-face colon (1+ colon) colon-face) |
| 1156 | (nxml-set-face (1+ colon) end local-name-face)) |
| 1157 | (t (nxml-set-face start end (or unprefixed-face |
| 1158 | local-name-face))))) |
| 1159 | |
| 1160 | ;;; Editing |
| 1161 | |
| 1162 | (defun nxml-electric-slash (arg) |
| 1163 | "Insert a slash. |
| 1164 | |
| 1165 | With a prefix ARG, do nothing other than insert the slash. |
| 1166 | |
| 1167 | Otherwise, if `nxml-slash-auto-complete-flag' is non-nil, insert the |
| 1168 | rest of the end-tag or empty-element if the slash is potentially part |
| 1169 | of an end-tag or the close of an empty-element. |
| 1170 | |
| 1171 | If the slash is part of an end-tag that is the first non-whitespace |
| 1172 | on the line, reindent the line." |
| 1173 | (interactive "*P") |
| 1174 | (nxml-ensure-scan-up-to-date) |
| 1175 | (let* ((slash-pos (point)) |
| 1176 | (end-tag-p (and (eq (char-before slash-pos) ?<) |
| 1177 | (not (nxml-get-inside slash-pos)))) |
| 1178 | (at-indentation (save-excursion |
| 1179 | (back-to-indentation) |
| 1180 | (eq (point) (1- slash-pos))))) |
| 1181 | (self-insert-command (prefix-numeric-value arg)) |
| 1182 | (unless arg |
| 1183 | (if nxml-slash-auto-complete-flag |
| 1184 | (if end-tag-p |
| 1185 | (condition-case nil |
| 1186 | (let ((start-tag-end |
| 1187 | (nxml-scan-element-backward (1- slash-pos) t))) |
| 1188 | (when start-tag-end |
| 1189 | (insert (xmltok-start-tag-qname) ">") |
| 1190 | ;; copy the indentation of the start-tag |
| 1191 | (when (and at-indentation |
| 1192 | (save-excursion |
| 1193 | (goto-char xmltok-start) |
| 1194 | (back-to-indentation) |
| 1195 | (eq (point) xmltok-start))) |
| 1196 | (save-excursion |
| 1197 | (indent-line-to (save-excursion |
| 1198 | (goto-char xmltok-start) |
| 1199 | (current-column))))))) |
| 1200 | (nxml-scan-error nil)) |
| 1201 | (when (and (eq (nxml-token-before) (point)) |
| 1202 | (eq xmltok-type 'partial-empty-element)) |
| 1203 | (insert ">")))) |
| 1204 | (when (and end-tag-p at-indentation) |
| 1205 | (nxml-indent-line))))) |
| 1206 | |
| 1207 | (defun nxml-balanced-close-start-tag-block () |
| 1208 | "Close the start-tag before point with `>' and insert a balancing end-tag. |
| 1209 | Point is left between the start-tag and the end-tag. |
| 1210 | If there is nothing but whitespace before the `<' that opens the |
| 1211 | start-tag, then put point on a blank line, and put the end-tag on |
| 1212 | another line aligned with the start-tag." |
| 1213 | (interactive "*") |
| 1214 | (nxml-balanced-close-start-tag 'block)) |
| 1215 | |
| 1216 | (defun nxml-balanced-close-start-tag-inline () |
| 1217 | "Close the start-tag before point with `>' and insert a balancing end-tag. |
| 1218 | Point is left between the start-tag and the end-tag. |
| 1219 | No extra whitespace is inserted." |
| 1220 | (interactive "*") |
| 1221 | (nxml-balanced-close-start-tag 'inline)) |
| 1222 | |
| 1223 | (defun nxml-balanced-close-start-tag (block-or-inline) |
| 1224 | (let ((token-end (nxml-token-before)) |
| 1225 | (pos (1+ (point))) |
| 1226 | (token-start xmltok-start)) |
| 1227 | (unless (or (eq xmltok-type 'partial-start-tag) |
| 1228 | (and (memq xmltok-type '(start-tag |
| 1229 | empty-element |
| 1230 | partial-empty-element)) |
| 1231 | (>= token-end pos))) |
| 1232 | (error "Not in a start-tag")) |
| 1233 | ;; Note that this insertion changes xmltok-start. |
| 1234 | (insert "></" |
| 1235 | (buffer-substring-no-properties (+ xmltok-start 1) |
| 1236 | (min xmltok-name-end (point))) |
| 1237 | ">") |
| 1238 | (if (eq block-or-inline 'inline) |
| 1239 | (goto-char pos) |
| 1240 | (goto-char token-start) |
| 1241 | (back-to-indentation) |
| 1242 | (if (= (point) token-start) |
| 1243 | (let ((indent (current-column))) |
| 1244 | (goto-char pos) |
| 1245 | (insert "\n") |
| 1246 | (indent-line-to indent) |
| 1247 | (goto-char pos) |
| 1248 | (insert "\n") |
| 1249 | (indent-line-to (+ nxml-child-indent indent))) |
| 1250 | (goto-char pos))))) |
| 1251 | |
| 1252 | (defun nxml-finish-element () |
| 1253 | "Finish the current element by inserting an end-tag." |
| 1254 | (interactive "*") |
| 1255 | (nxml-finish-element-1 nil)) |
| 1256 | |
| 1257 | (defvar nxml-last-split-position nil |
| 1258 | "Position where `nxml-split-element' split the current element.") |
| 1259 | |
| 1260 | (defun nxml-split-element () |
| 1261 | "Split the current element by inserting an end-tag and a start-tag. |
| 1262 | Point is left after the newly inserted start-tag. When repeated, |
| 1263 | split immediately before the previously inserted start-tag and leave |
| 1264 | point unchanged." |
| 1265 | (interactive "*") |
| 1266 | (setq nxml-last-split-position |
| 1267 | (if (and (eq last-command this-command) |
| 1268 | nxml-last-split-position) |
| 1269 | (save-excursion |
| 1270 | (goto-char nxml-last-split-position) |
| 1271 | (nxml-finish-element-1 t)) |
| 1272 | (nxml-finish-element-1 t)))) |
| 1273 | |
| 1274 | (defun nxml-finish-element-1 (startp) |
| 1275 | "Insert an end-tag for the current element and optionally a start-tag. |
| 1276 | The start-tag is inserted if STARTP is non-nil. Return the position |
| 1277 | of the inserted start-tag or nil if none was inserted." |
| 1278 | (interactive "*") |
| 1279 | (let* ((token-end (nxml-token-before)) |
| 1280 | (start-tag-end |
| 1281 | (save-excursion |
| 1282 | (when (and (< (point) token-end) |
| 1283 | (memq xmltok-type |
| 1284 | '(cdata-section |
| 1285 | processing-instruction |
| 1286 | comment |
| 1287 | start-tag |
| 1288 | end-tag |
| 1289 | empty-element))) |
| 1290 | (error "Point is inside a %s" |
| 1291 | (nxml-token-type-friendly-name xmltok-type))) |
| 1292 | (nxml-scan-element-backward token-end t))) |
| 1293 | (starts-line |
| 1294 | (save-excursion |
| 1295 | (unless (eq xmltok-type 'start-tag) |
| 1296 | (error "No matching start-tag")) |
| 1297 | (goto-char xmltok-start) |
| 1298 | (back-to-indentation) |
| 1299 | (eq (point) xmltok-start))) |
| 1300 | (ends-line |
| 1301 | (save-excursion |
| 1302 | (goto-char start-tag-end) |
| 1303 | (looking-at "[ \t\r\n]*$"))) |
| 1304 | (start-tag-indent (save-excursion |
| 1305 | (goto-char xmltok-start) |
| 1306 | (current-column))) |
| 1307 | (qname (xmltok-start-tag-qname)) |
| 1308 | inserted-start-tag-pos) |
| 1309 | (when (and starts-line ends-line) |
| 1310 | ;; start-tag is on a line by itself |
| 1311 | ;; => put the end-tag on a line by itself |
| 1312 | (unless (<= (point) |
| 1313 | (save-excursion |
| 1314 | (back-to-indentation) |
| 1315 | (point))) |
| 1316 | (insert "\n")) |
| 1317 | (indent-line-to start-tag-indent)) |
| 1318 | (insert "</" qname ">") |
| 1319 | (when startp |
| 1320 | (when starts-line |
| 1321 | (insert "\n") |
| 1322 | (indent-line-to start-tag-indent)) |
| 1323 | (setq inserted-start-tag-pos (point)) |
| 1324 | (insert "<" qname ">") |
| 1325 | (when (and starts-line ends-line) |
| 1326 | (insert "\n") |
| 1327 | (indent-line-to (save-excursion |
| 1328 | (goto-char xmltok-start) |
| 1329 | (forward-line 1) |
| 1330 | (back-to-indentation) |
| 1331 | (if (= (current-column) |
| 1332 | (+ start-tag-indent nxml-child-indent)) |
| 1333 | (+ start-tag-indent nxml-child-indent) |
| 1334 | start-tag-indent))))) |
| 1335 | inserted-start-tag-pos)) |
| 1336 | |
| 1337 | ;;; Indentation |
| 1338 | |
| 1339 | (defun nxml-indent-line () |
| 1340 | "Indent current line as XML." |
| 1341 | (let* ((savep (point)) |
| 1342 | (indent (condition-case nil |
| 1343 | (save-excursion |
| 1344 | (forward-line 0) |
| 1345 | (skip-chars-forward " \t") |
| 1346 | (if (>= (point) savep) (setq savep nil)) |
| 1347 | (or (nxml-compute-indent) 0)) |
| 1348 | (error 0)))) |
| 1349 | (if (not (numberp indent)) |
| 1350 | ;; If something funny is used (e.g. `noindent'), return it. |
| 1351 | indent |
| 1352 | (if (< indent 0) (setq indent 0)) ;Just in case. |
| 1353 | (if savep |
| 1354 | (save-excursion (indent-line-to indent)) |
| 1355 | (indent-line-to indent))))) |
| 1356 | |
| 1357 | (defun nxml-compute-indent () |
| 1358 | "Return the indent for the line containing point." |
| 1359 | (or (nxml-compute-indent-from-matching-start-tag) |
| 1360 | (nxml-compute-indent-from-previous-line))) |
| 1361 | |
| 1362 | (defun nxml-compute-indent-from-matching-start-tag () |
| 1363 | "Compute the indent for a line with an end-tag using the matching start-tag. |
| 1364 | When the line containing point ends with an end-tag and does not start |
| 1365 | in the middle of a token, return the indent of the line containing the |
| 1366 | matching start-tag, if there is one and it occurs at the beginning of |
| 1367 | its line. Otherwise return nil." |
| 1368 | (save-excursion |
| 1369 | (back-to-indentation) |
| 1370 | (let ((bol (point))) |
| 1371 | (let ((inhibit-field-text-motion t)) |
| 1372 | (end-of-line)) |
| 1373 | (skip-chars-backward " \t") |
| 1374 | (and (= (nxml-token-before) (point)) |
| 1375 | (memq xmltok-type '(end-tag partial-end-tag)) |
| 1376 | ;; start of line must not be inside a token |
| 1377 | (or (= xmltok-start bol) |
| 1378 | (save-excursion |
| 1379 | (goto-char bol) |
| 1380 | (nxml-token-after) |
| 1381 | (= xmltok-start bol)) |
| 1382 | (eq xmltok-type 'data)) |
| 1383 | (condition-case nil |
| 1384 | (nxml-scan-element-backward |
| 1385 | (point) |
| 1386 | nil |
| 1387 | (- (point) |
| 1388 | nxml-end-tag-indent-scan-distance)) |
| 1389 | (nxml-scan-error nil)) |
| 1390 | (< xmltok-start bol) |
| 1391 | (progn |
| 1392 | (goto-char xmltok-start) |
| 1393 | (skip-chars-backward " \t") |
| 1394 | (bolp)) |
| 1395 | (current-indentation))))) |
| 1396 | |
| 1397 | (defun nxml-compute-indent-from-previous-line () |
| 1398 | "Compute the indent for a line using the indentation of a previous line." |
| 1399 | (save-excursion |
| 1400 | (end-of-line) |
| 1401 | (let ((eol (point)) |
| 1402 | bol prev-bol ref |
| 1403 | before-context after-context) |
| 1404 | (back-to-indentation) |
| 1405 | (setq bol (point)) |
| 1406 | (catch 'indent |
| 1407 | ;; Move backwards until the start of a non-blank line that is |
| 1408 | ;; not inside a token. |
| 1409 | (while (progn |
| 1410 | (when (= (forward-line -1) -1) |
| 1411 | (throw 'indent 0)) |
| 1412 | (back-to-indentation) |
| 1413 | (if (looking-at "[ \t]*$") |
| 1414 | t |
| 1415 | (or prev-bol |
| 1416 | (setq prev-bol (point))) |
| 1417 | (nxml-token-after) |
| 1418 | (not (or (= xmltok-start (point)) |
| 1419 | (eq xmltok-type 'data)))))) |
| 1420 | (setq ref (point)) |
| 1421 | ;; Now scan over tokens until the end of the line to be indented. |
| 1422 | ;; Determine the context before and after the beginning of the |
| 1423 | ;; line. |
| 1424 | (while (< (point) eol) |
| 1425 | (nxml-tokenize-forward) |
| 1426 | (cond ((<= bol xmltok-start) |
| 1427 | (setq after-context |
| 1428 | (nxml-merge-indent-context-type after-context))) |
| 1429 | ((and (<= (point) bol) |
| 1430 | (not (and (eq xmltok-type 'partial-start-tag) |
| 1431 | (= (point) bol)))) |
| 1432 | (setq before-context |
| 1433 | (nxml-merge-indent-context-type before-context))) |
| 1434 | ((eq xmltok-type 'data) |
| 1435 | (setq before-context |
| 1436 | (nxml-merge-indent-context-type before-context)) |
| 1437 | (setq after-context |
| 1438 | (nxml-merge-indent-context-type after-context))) |
| 1439 | ;; If in the middle of a token that looks inline, |
| 1440 | ;; then indent relative to the previous non-blank line |
| 1441 | ((eq (nxml-merge-indent-context-type before-context) |
| 1442 | 'mixed) |
| 1443 | (goto-char prev-bol) |
| 1444 | (throw 'indent (current-column))) |
| 1445 | (t |
| 1446 | (throw 'indent |
| 1447 | (nxml-compute-indent-in-token bol)))) |
| 1448 | (skip-chars-forward " \t\r\n")) |
| 1449 | (goto-char ref) |
| 1450 | (+ (current-column) |
| 1451 | (* nxml-child-indent |
| 1452 | (+ (if (eq before-context 'start-tag) 1 0) |
| 1453 | (if (eq after-context 'end-tag) -1 0)))))))) |
| 1454 | |
| 1455 | (defun nxml-merge-indent-context-type (context) |
| 1456 | "Merge the indent context type CONTEXT with the token in `xmltok-type'. |
| 1457 | Return the merged indent context type. An indent context type is |
| 1458 | either nil or one of the symbols `start-tag', `end-tag', `markup', |
| 1459 | `comment', `mixed'." |
| 1460 | (cond ((memq xmltok-type '(start-tag partial-start-tag)) |
| 1461 | (if (memq context '(nil start-tag comment)) |
| 1462 | 'start-tag |
| 1463 | 'mixed)) |
| 1464 | ((memq xmltok-type '(end-tag partial-end-tag)) |
| 1465 | (if (memq context '(nil end-tag comment)) |
| 1466 | 'end-tag |
| 1467 | 'mixed)) |
| 1468 | ((eq xmltok-type 'comment) |
| 1469 | (cond ((memq context '(start-tag end-tag comment)) |
| 1470 | context) |
| 1471 | (context 'mixed) |
| 1472 | (t 'comment))) |
| 1473 | (context 'mixed) |
| 1474 | (t 'markup))) |
| 1475 | |
| 1476 | (defun nxml-compute-indent-in-token (pos) |
| 1477 | "Return the indent for a line that starts inside a token. |
| 1478 | POS is the position of the first non-whitespace character of the line. |
| 1479 | This expects the xmltok-* variables to be set up as by `xmltok-forward'." |
| 1480 | (cond ((memq xmltok-type '(start-tag |
| 1481 | partial-start-tag |
| 1482 | empty-element |
| 1483 | partial-empty-element)) |
| 1484 | (nxml-compute-indent-in-start-tag pos)) |
| 1485 | ((eq xmltok-type 'comment) |
| 1486 | (nxml-compute-indent-in-delimited-token pos "<!--" "-->")) |
| 1487 | ((eq xmltok-type 'cdata-section) |
| 1488 | (nxml-compute-indent-in-delimited-token pos "<![CDATA[" "]]>")) |
| 1489 | ((eq xmltok-type 'processing-instruction) |
| 1490 | (nxml-compute-indent-in-delimited-token pos "<?" "?>")) |
| 1491 | (t |
| 1492 | (goto-char pos) |
| 1493 | (if (and (= (forward-line -1) 0) |
| 1494 | (< xmltok-start (point))) |
| 1495 | (back-to-indentation) |
| 1496 | (goto-char xmltok-start)) |
| 1497 | (current-column)))) |
| 1498 | |
| 1499 | (defun nxml-compute-indent-in-start-tag (pos) |
| 1500 | "Return the indent for a line that starts inside a start-tag. |
| 1501 | Also for a line that starts inside an empty element. |
| 1502 | POS is the position of the first non-whitespace character of the line. |
| 1503 | This expects the xmltok-* variables to be set up as by `xmltok-forward'." |
| 1504 | (let ((value-boundary (nxml-attribute-value-boundary pos)) |
| 1505 | (off 0)) |
| 1506 | (if value-boundary |
| 1507 | ;; inside an attribute value |
| 1508 | (let ((value-start (car value-boundary))) |
| 1509 | (goto-char pos) |
| 1510 | (forward-line -1) |
| 1511 | (if (< (point) value-start) |
| 1512 | (goto-char value-start) |
| 1513 | (back-to-indentation))) |
| 1514 | ;; outside an attribute value |
| 1515 | (goto-char pos) |
| 1516 | (while (and (= (forward-line -1) 0) |
| 1517 | (nxml-attribute-value-boundary (point)))) |
| 1518 | (cond ((<= (point) xmltok-start) |
| 1519 | (goto-char xmltok-start) |
| 1520 | (setq off nxml-attribute-indent) |
| 1521 | (let ((atts (xmltok-merge-attributes))) |
| 1522 | (when atts |
| 1523 | (let* ((att (car atts)) |
| 1524 | (start (xmltok-attribute-name-start att))) |
| 1525 | (when (< start pos) |
| 1526 | (goto-char start) |
| 1527 | (setq off 0)))))) |
| 1528 | (t |
| 1529 | (back-to-indentation)))) |
| 1530 | (+ (current-column) off))) |
| 1531 | |
| 1532 | (defun nxml-attribute-value-boundary (pos) |
| 1533 | "Return a pair (START . END) if POS is inside an attribute value. |
| 1534 | Otherwise return nil. START and END are the positions of the start |
| 1535 | and end of the attribute value containing POS. This expects the |
| 1536 | xmltok-* variables to be set up as by `xmltok-forward'." |
| 1537 | (let ((atts (xmltok-merge-attributes)) |
| 1538 | att value-start value-end value-boundary) |
| 1539 | (while atts |
| 1540 | (setq att (car atts)) |
| 1541 | (setq value-start (xmltok-attribute-value-start att)) |
| 1542 | (setq value-end (xmltok-attribute-value-end att)) |
| 1543 | (cond ((and value-start (< pos value-start)) |
| 1544 | (setq atts nil)) |
| 1545 | ((and value-start value-end (<= pos value-end)) |
| 1546 | (setq value-boundary (cons value-start value-end)) |
| 1547 | (setq atts nil)) |
| 1548 | (t (setq atts (cdr atts))))) |
| 1549 | value-boundary)) |
| 1550 | |
| 1551 | (defun nxml-compute-indent-in-delimited-token (pos open-delim close-delim) |
| 1552 | "Return the indent for a line that starts inside a token with delimiters. |
| 1553 | OPEN-DELIM and CLOSE-DELIM are strings giving the opening and closing |
| 1554 | delimiters. POS is the position of the first non-whitespace character |
| 1555 | of the line. This expects the xmltok-* variables to be set up as by |
| 1556 | `xmltok-forward'." |
| 1557 | (cond ((let ((end (+ pos (length close-delim)))) |
| 1558 | (and (<= end (point-max)) |
| 1559 | (string= (buffer-substring-no-properties pos end) |
| 1560 | close-delim))) |
| 1561 | (goto-char xmltok-start)) |
| 1562 | ((progn |
| 1563 | (goto-char pos) |
| 1564 | (forward-line -1) |
| 1565 | (<= (point) xmltok-start)) |
| 1566 | (goto-char (+ xmltok-start (length open-delim))) |
| 1567 | (when (and (string= open-delim "<!--") |
| 1568 | (looking-at " ")) |
| 1569 | (goto-char (1+ (point))))) |
| 1570 | (t (back-to-indentation))) |
| 1571 | (current-column)) |
| 1572 | |
| 1573 | ;;; Completion |
| 1574 | |
| 1575 | (defun nxml-complete () |
| 1576 | "Perform completion on the symbol preceding point. |
| 1577 | |
| 1578 | Inserts as many characters as can be completed. However, if not even |
| 1579 | one character can be completed, then a buffer with the possibilities |
| 1580 | is popped up and the symbol is read from the minibuffer with |
| 1581 | completion. If the symbol is complete, then any characters that must |
| 1582 | follow the symbol are also inserted. |
| 1583 | |
| 1584 | The name space used for completion and what is treated as a symbol |
| 1585 | depends on the context. The contexts in which completion is performed |
| 1586 | depend on `nxml-completion-hook'." |
| 1587 | (interactive) |
| 1588 | (unless (run-hook-with-args-until-success 'nxml-completion-hook) |
| 1589 | ;; Eventually we will complete on entity names here. |
| 1590 | (ding) |
| 1591 | (message "Cannot complete in this context"))) |
| 1592 | |
| 1593 | (defun nxml-completion-at-point-function () |
| 1594 | "Call `nxml-complete' to perform completion at point." |
| 1595 | (when nxml-bind-meta-tab-to-complete-flag |
| 1596 | #'nxml-complete)) |
| 1597 | |
| 1598 | ;;; Movement |
| 1599 | |
| 1600 | (defun nxml-forward-balanced-item (&optional arg) |
| 1601 | "Move forward across one balanced item. |
| 1602 | With ARG, do it that many times. Negative arg -N means |
| 1603 | move backward across N balanced expressions. |
| 1604 | This is the equivalent of `forward-sexp' for XML. |
| 1605 | |
| 1606 | An element contains as items strings with no markup, tags, processing |
| 1607 | instructions, comments, CDATA sections, entity references and |
| 1608 | characters references. However, if the variable |
| 1609 | `nxml-sexp-element-flag' is non-nil, then an element is treated as a |
| 1610 | single markup item. A start-tag contains an element name followed by |
| 1611 | one or more attributes. An end-tag contains just an element name. |
| 1612 | An attribute value literals contains strings with no markup, entity |
| 1613 | references and character references. A processing instruction |
| 1614 | consists of a target and a content string. A comment or a CDATA |
| 1615 | section contains a single string. An entity reference contains a |
| 1616 | single name. A character reference contains a character number." |
| 1617 | (interactive "p") |
| 1618 | (or arg (setq arg 1)) |
| 1619 | (cond ((> arg 0) |
| 1620 | (while (progn |
| 1621 | (nxml-forward-single-balanced-item) |
| 1622 | (> (setq arg (1- arg)) 0)))) |
| 1623 | ((< arg 0) |
| 1624 | (while (progn |
| 1625 | (nxml-backward-single-balanced-item) |
| 1626 | (< (setq arg (1+ arg)) 0)))))) |
| 1627 | |
| 1628 | (defun nxml-forward-single-balanced-item () |
| 1629 | (condition-case err |
| 1630 | (goto-char (let ((end (nxml-token-after))) |
| 1631 | (save-excursion |
| 1632 | (while (eq xmltok-type 'space) |
| 1633 | (goto-char end) |
| 1634 | (setq end (nxml-token-after))) |
| 1635 | (cond ((/= (point) xmltok-start) |
| 1636 | (nxml-scan-forward-within end)) |
| 1637 | ((and nxml-sexp-element-flag |
| 1638 | (eq xmltok-type 'start-tag)) |
| 1639 | ;; can't ever return nil here |
| 1640 | (nxml-scan-element-forward xmltok-start)) |
| 1641 | ((and nxml-sexp-element-flag |
| 1642 | (memq xmltok-type |
| 1643 | '(end-tag partial-end-tag))) |
| 1644 | (error "Already at end of element")) |
| 1645 | (t end))))) |
| 1646 | (nxml-scan-error |
| 1647 | (goto-char (cadr err)) |
| 1648 | (apply 'error (cddr err))))) |
| 1649 | |
| 1650 | (defun nxml-backward-single-balanced-item () |
| 1651 | (condition-case err |
| 1652 | (goto-char (let ((end (nxml-token-before))) |
| 1653 | (save-excursion |
| 1654 | (while (eq xmltok-type 'space) |
| 1655 | (goto-char xmltok-start) |
| 1656 | (setq end (nxml-token-before))) |
| 1657 | (cond ((/= (point) end) |
| 1658 | (nxml-scan-backward-within end)) |
| 1659 | ((and nxml-sexp-element-flag |
| 1660 | (eq xmltok-type 'end-tag)) |
| 1661 | ;; can't ever return nil here |
| 1662 | (nxml-scan-element-backward end) |
| 1663 | xmltok-start) |
| 1664 | ((and nxml-sexp-element-flag |
| 1665 | (eq xmltok-type 'start-tag)) |
| 1666 | (error "Already at start of element")) |
| 1667 | (t xmltok-start))))) |
| 1668 | (nxml-scan-error |
| 1669 | (goto-char (cadr err)) |
| 1670 | (apply 'error (cddr err))))) |
| 1671 | |
| 1672 | (defun nxml-scan-forward-within (end) |
| 1673 | (setq end (- end (nxml-end-delimiter-length xmltok-type))) |
| 1674 | (when (<= end (point)) |
| 1675 | (error "Already at end of %s" |
| 1676 | (nxml-token-type-friendly-name xmltok-type))) |
| 1677 | (cond ((memq xmltok-type '(start-tag |
| 1678 | empty-element |
| 1679 | partial-start-tag |
| 1680 | partial-empty-element)) |
| 1681 | (if (< (point) xmltok-name-end) |
| 1682 | xmltok-name-end |
| 1683 | (let ((att (nxml-find-following-attribute))) |
| 1684 | (cond ((not att) end) |
| 1685 | ((and (xmltok-attribute-value-start att) |
| 1686 | (<= (xmltok-attribute-value-start att) |
| 1687 | (point))) |
| 1688 | (nxml-scan-forward-in-attribute-value att)) |
| 1689 | ((xmltok-attribute-value-end att) |
| 1690 | (1+ (xmltok-attribute-value-end att))) |
| 1691 | ((save-excursion |
| 1692 | (goto-char (xmltok-attribute-name-end att)) |
| 1693 | (looking-at "[ \t\r\n]*=")) |
| 1694 | (match-end 0)) |
| 1695 | (t (xmltok-attribute-name-end att)))))) |
| 1696 | ((and (eq xmltok-type 'processing-instruction) |
| 1697 | (< (point) xmltok-name-end)) |
| 1698 | xmltok-name-end) |
| 1699 | (t end))) |
| 1700 | |
| 1701 | (defun nxml-scan-backward-within (_end) |
| 1702 | (setq xmltok-start |
| 1703 | (+ xmltok-start |
| 1704 | (nxml-start-delimiter-length xmltok-type))) |
| 1705 | (when (<= (point) xmltok-start) |
| 1706 | (error "Already at start of %s" |
| 1707 | (nxml-token-type-friendly-name xmltok-type))) |
| 1708 | (cond ((memq xmltok-type '(start-tag |
| 1709 | empty-element |
| 1710 | partial-start-tag |
| 1711 | partial-empty-element)) |
| 1712 | (let ((att (nxml-find-preceding-attribute))) |
| 1713 | (cond ((not att) xmltok-start) |
| 1714 | ((and (xmltok-attribute-value-start att) |
| 1715 | (<= (xmltok-attribute-value-start att) |
| 1716 | (point)) |
| 1717 | (<= (point) |
| 1718 | (xmltok-attribute-value-end att))) |
| 1719 | (nxml-scan-backward-in-attribute-value att)) |
| 1720 | (t (xmltok-attribute-name-start att))))) |
| 1721 | ((and (eq xmltok-type 'processing-instruction) |
| 1722 | (let ((content-start (save-excursion |
| 1723 | (goto-char xmltok-name-end) |
| 1724 | (skip-chars-forward " \r\t\n") |
| 1725 | (point)))) |
| 1726 | (and (< content-start (point)) |
| 1727 | content-start)))) |
| 1728 | (t xmltok-start))) |
| 1729 | |
| 1730 | (defun nxml-scan-forward-in-attribute-value (att) |
| 1731 | (when (= (point) (xmltok-attribute-value-end att)) |
| 1732 | (error "Already at end of attribute value")) |
| 1733 | (let ((refs (xmltok-attribute-refs att)) |
| 1734 | ref) |
| 1735 | (while refs |
| 1736 | (setq ref (car refs)) |
| 1737 | (if (< (point) (aref ref 2)) |
| 1738 | (setq refs nil) |
| 1739 | (setq ref nil) |
| 1740 | (setq refs (cdr refs)))) |
| 1741 | (cond ((not ref) |
| 1742 | (xmltok-attribute-value-end att)) |
| 1743 | ((< (point) (aref ref 1)) |
| 1744 | (aref ref 1)) |
| 1745 | ((= (point) (aref ref 1)) |
| 1746 | (aref ref 2)) |
| 1747 | (t |
| 1748 | (let ((end (- (aref ref 2) |
| 1749 | (nxml-end-delimiter-length (aref ref 0))))) |
| 1750 | (if (< (point) end) |
| 1751 | end |
| 1752 | (error "Already at end of %s" |
| 1753 | (nxml-token-type-friendly-name (aref ref 0))))))))) |
| 1754 | |
| 1755 | (defun nxml-scan-backward-in-attribute-value (att) |
| 1756 | (when (= (point) (xmltok-attribute-value-start att)) |
| 1757 | (error "Already at start of attribute value")) |
| 1758 | (let ((refs (reverse (xmltok-attribute-refs att))) |
| 1759 | ref) |
| 1760 | (while refs |
| 1761 | (setq ref (car refs)) |
| 1762 | (if (< (aref ref 1) (point)) |
| 1763 | (setq refs nil) |
| 1764 | (setq ref nil) |
| 1765 | (setq refs (cdr refs)))) |
| 1766 | (cond ((not ref) |
| 1767 | (xmltok-attribute-value-start att)) |
| 1768 | ((< (aref ref 2) (point)) |
| 1769 | (aref ref 2)) |
| 1770 | ((= (point) (aref ref 2)) |
| 1771 | (aref ref 1)) |
| 1772 | (t |
| 1773 | (let ((start (+ (aref ref 1) |
| 1774 | (nxml-start-delimiter-length (aref ref 0))))) |
| 1775 | (if (< start (point)) |
| 1776 | start |
| 1777 | (error "Already at start of %s" |
| 1778 | (nxml-token-type-friendly-name (aref ref 0))))))))) |
| 1779 | |
| 1780 | (defun nxml-find-following-attribute () |
| 1781 | (let ((ret nil) |
| 1782 | (atts (or xmltok-attributes xmltok-namespace-attributes)) |
| 1783 | (more-atts (and xmltok-attributes xmltok-namespace-attributes))) |
| 1784 | (while atts |
| 1785 | (let* ((att (car atts)) |
| 1786 | (name-start (xmltok-attribute-name-start att))) |
| 1787 | (cond ((and (<= name-start (point)) |
| 1788 | (xmltok-attribute-value-end att) |
| 1789 | ;; <= because end is before quote |
| 1790 | (<= (point) (xmltok-attribute-value-end att))) |
| 1791 | (setq atts nil) |
| 1792 | (setq ret att)) |
| 1793 | ((and (< (point) name-start) |
| 1794 | (or (not ret) |
| 1795 | (< name-start |
| 1796 | (xmltok-attribute-name-start ret)))) |
| 1797 | (setq ret att)))) |
| 1798 | (setq atts (cdr atts)) |
| 1799 | (unless atts |
| 1800 | (setq atts more-atts) |
| 1801 | (setq more-atts nil))) |
| 1802 | ret)) |
| 1803 | |
| 1804 | (defun nxml-find-preceding-attribute () |
| 1805 | (let ((ret nil) |
| 1806 | (atts (or xmltok-attributes xmltok-namespace-attributes)) |
| 1807 | (more-atts (and xmltok-attributes xmltok-namespace-attributes))) |
| 1808 | (while atts |
| 1809 | (let* ((att (car atts)) |
| 1810 | (name-start (xmltok-attribute-name-start att))) |
| 1811 | (cond ((and (< name-start (point)) |
| 1812 | (xmltok-attribute-value-end att) |
| 1813 | ;; <= because end is before quote |
| 1814 | (<= (point) (xmltok-attribute-value-end att))) |
| 1815 | (setq atts nil) |
| 1816 | (setq ret att)) |
| 1817 | ((and (< name-start (point)) |
| 1818 | (or (not ret) |
| 1819 | (< (xmltok-attribute-name-start ret) |
| 1820 | name-start))) |
| 1821 | (setq ret att)))) |
| 1822 | (setq atts (cdr atts)) |
| 1823 | (unless atts |
| 1824 | (setq atts more-atts) |
| 1825 | (setq more-atts nil))) |
| 1826 | ret)) |
| 1827 | |
| 1828 | (defun nxml-up-element (&optional arg) |
| 1829 | (interactive "p") |
| 1830 | (or arg (setq arg 1)) |
| 1831 | (if (< arg 0) |
| 1832 | (nxml-backward-up-element (- arg)) |
| 1833 | (condition-case err |
| 1834 | (while (and (> arg 0) |
| 1835 | (< (point) (point-max))) |
| 1836 | (let ((token-end (nxml-token-after))) |
| 1837 | (goto-char (cond ((or (memq xmltok-type '(end-tag |
| 1838 | partial-end-tag)) |
| 1839 | (and (memq xmltok-type |
| 1840 | '(empty-element |
| 1841 | partial-empty-element)) |
| 1842 | (< xmltok-start (point)))) |
| 1843 | token-end) |
| 1844 | ((nxml-scan-element-forward |
| 1845 | (if (and (eq xmltok-type 'start-tag) |
| 1846 | (= (point) xmltok-start)) |
| 1847 | xmltok-start |
| 1848 | token-end) |
| 1849 | t)) |
| 1850 | (t (error "No parent element"))))) |
| 1851 | (setq arg (1- arg))) |
| 1852 | (nxml-scan-error |
| 1853 | (goto-char (cadr err)) |
| 1854 | (apply 'error (cddr err)))))) |
| 1855 | |
| 1856 | (defun nxml-backward-up-element (&optional arg) |
| 1857 | (interactive "p") |
| 1858 | (or arg (setq arg 1)) |
| 1859 | (if (< arg 0) |
| 1860 | (nxml-up-element (- arg)) |
| 1861 | (condition-case err |
| 1862 | (while (and (> arg 0) |
| 1863 | (< (point-min) (point))) |
| 1864 | (let ((token-end (nxml-token-before))) |
| 1865 | (goto-char (cond ((or (memq xmltok-type '(start-tag |
| 1866 | partial-start-tag)) |
| 1867 | (and (memq xmltok-type |
| 1868 | '(empty-element |
| 1869 | partial-empty-element)) |
| 1870 | (< (point) token-end))) |
| 1871 | xmltok-start) |
| 1872 | ((nxml-scan-element-backward |
| 1873 | (if (and (eq xmltok-type 'end-tag) |
| 1874 | (= (point) token-end)) |
| 1875 | token-end |
| 1876 | xmltok-start) |
| 1877 | t) |
| 1878 | xmltok-start) |
| 1879 | (t (error "No parent element"))))) |
| 1880 | (setq arg (1- arg))) |
| 1881 | (nxml-scan-error |
| 1882 | (goto-char (cadr err)) |
| 1883 | (apply 'error (cddr err)))))) |
| 1884 | |
| 1885 | (defun nxml-down-element (&optional arg) |
| 1886 | "Move forward down into the content of an element. |
| 1887 | With ARG, do this that many times. |
| 1888 | Negative ARG means move backward but still down." |
| 1889 | (interactive "p") |
| 1890 | (or arg (setq arg 1)) |
| 1891 | (if (< arg 0) |
| 1892 | (nxml-backward-down-element (- arg)) |
| 1893 | (while (> arg 0) |
| 1894 | (goto-char |
| 1895 | (let ((token-end (nxml-token-after))) |
| 1896 | (save-excursion |
| 1897 | (goto-char token-end) |
| 1898 | (while (progn |
| 1899 | (when (memq xmltok-type '(nil end-tag partial-end-tag)) |
| 1900 | (error "No following start-tags in this element")) |
| 1901 | (not (memq xmltok-type '(start-tag partial-start-tag)))) |
| 1902 | (nxml-tokenize-forward)) |
| 1903 | (point)))) |
| 1904 | (setq arg (1- arg))))) |
| 1905 | |
| 1906 | (defun nxml-backward-down-element (&optional arg) |
| 1907 | (interactive "p") |
| 1908 | (or arg (setq arg 1)) |
| 1909 | (if (< arg 0) |
| 1910 | (nxml-down-element (- arg)) |
| 1911 | (while (> arg 0) |
| 1912 | (goto-char |
| 1913 | (save-excursion |
| 1914 | (nxml-token-before) |
| 1915 | (goto-char xmltok-start) |
| 1916 | (while (progn |
| 1917 | (when (memq xmltok-type '(start-tag |
| 1918 | partial-start-tag |
| 1919 | prolog |
| 1920 | nil)) |
| 1921 | (error "No preceding end-tags in this element")) |
| 1922 | (not (memq xmltok-type '(end-tag partial-end-tag)))) |
| 1923 | (if (or (<= (point) nxml-prolog-end) |
| 1924 | (not (search-backward "<" nxml-prolog-end t))) |
| 1925 | (setq xmltok-type nil) |
| 1926 | (nxml-move-outside-backwards) |
| 1927 | (xmltok-forward))) |
| 1928 | xmltok-start)) |
| 1929 | (setq arg (1- arg))))) |
| 1930 | |
| 1931 | (defun nxml-forward-element (&optional arg) |
| 1932 | "Move forward over one element. |
| 1933 | With ARG, do it that many times. |
| 1934 | Negative ARG means move backward." |
| 1935 | (interactive "p") |
| 1936 | (or arg (setq arg 1)) |
| 1937 | (if (< arg 0) |
| 1938 | (nxml-backward-element (- arg)) |
| 1939 | (condition-case err |
| 1940 | (while (and (> arg 0) |
| 1941 | (< (point) (point-max))) |
| 1942 | (goto-char |
| 1943 | (or (nxml-scan-element-forward (nxml-token-before)) |
| 1944 | (error "No more elements"))) |
| 1945 | (setq arg (1- arg))) |
| 1946 | (nxml-scan-error |
| 1947 | (goto-char (cadr err)) |
| 1948 | (apply 'error (cddr err)))))) |
| 1949 | |
| 1950 | (defun nxml-backward-element (&optional arg) |
| 1951 | "Move backward over one element. |
| 1952 | With ARG, do it that many times. |
| 1953 | Negative ARG means move forward." |
| 1954 | (interactive "p") |
| 1955 | (or arg (setq arg 1)) |
| 1956 | (if (< arg 0) |
| 1957 | (nxml-forward-element (- arg)) |
| 1958 | (condition-case err |
| 1959 | (while (and (> arg 0) |
| 1960 | (< (point-min) (point))) |
| 1961 | (goto-char |
| 1962 | (or (and (nxml-scan-element-backward (progn |
| 1963 | (nxml-token-after) |
| 1964 | xmltok-start)) |
| 1965 | xmltok-start) |
| 1966 | (error "No preceding elements"))) |
| 1967 | (setq arg (1- arg))) |
| 1968 | (nxml-scan-error |
| 1969 | (goto-char (cadr err)) |
| 1970 | (apply 'error (cddr err)))))) |
| 1971 | |
| 1972 | (defun nxml-mark-token-after () |
| 1973 | (interactive) |
| 1974 | (push-mark (nxml-token-after) nil t) |
| 1975 | (goto-char xmltok-start) |
| 1976 | (message "Marked %s" xmltok-type)) |
| 1977 | |
| 1978 | ;;; Paragraphs |
| 1979 | |
| 1980 | (defun nxml-mark-paragraph () |
| 1981 | "Put point at beginning of this paragraph, mark at end. |
| 1982 | The paragraph marked is the one that contains point or follows point." |
| 1983 | (interactive) |
| 1984 | (nxml-forward-paragraph) |
| 1985 | (push-mark nil t t) |
| 1986 | (nxml-backward-paragraph)) |
| 1987 | |
| 1988 | (defun nxml-forward-paragraph (&optional arg) |
| 1989 | (interactive "p") |
| 1990 | (or arg (setq arg 1)) |
| 1991 | (cond ((< arg 0) |
| 1992 | (nxml-backward-paragraph (- arg))) |
| 1993 | ((> arg 0) |
| 1994 | (forward-line 0) |
| 1995 | (while (and (nxml-forward-single-paragraph) |
| 1996 | (> (setq arg (1- arg)) 0)))))) |
| 1997 | |
| 1998 | (defun nxml-backward-paragraph (&optional arg) |
| 1999 | (interactive "p") |
| 2000 | (or arg (setq arg 1)) |
| 2001 | (cond ((< arg 0) |
| 2002 | (nxml-forward-paragraph (- arg))) |
| 2003 | ((> arg 0) |
| 2004 | (unless (bolp) |
| 2005 | (let ((inhibit-field-text-motion t)) |
| 2006 | (end-of-line))) |
| 2007 | (while (and (nxml-backward-single-paragraph) |
| 2008 | (> (setq arg (1- arg)) 0)))))) |
| 2009 | |
| 2010 | (defun nxml-forward-single-paragraph () |
| 2011 | "Move forward over a single paragraph. |
| 2012 | Return nil at end of buffer, t otherwise." |
| 2013 | (let* ((token-end (nxml-token-after)) |
| 2014 | (offset (- (point) xmltok-start)) |
| 2015 | pos had-data) |
| 2016 | (goto-char token-end) |
| 2017 | (while (and (< (point) (point-max)) |
| 2018 | (not (setq pos |
| 2019 | (nxml-paragraph-end-pos had-data offset)))) |
| 2020 | (when (nxml-token-contains-data-p offset) |
| 2021 | (setq had-data t)) |
| 2022 | (nxml-tokenize-forward) |
| 2023 | (setq offset 0)) |
| 2024 | (when pos (goto-char pos)))) |
| 2025 | |
| 2026 | (defun nxml-backward-single-paragraph () |
| 2027 | "Move backward over a single paragraph. |
| 2028 | Return nil at start of buffer, t otherwise." |
| 2029 | (let* ((token-end (nxml-token-before)) |
| 2030 | (offset (- token-end (point))) |
| 2031 | (last-tag-pos xmltok-start) |
| 2032 | pos had-data last-data-pos) |
| 2033 | (goto-char token-end) |
| 2034 | (unless (setq pos (nxml-paragraph-start-pos nil offset)) |
| 2035 | (setq had-data (nxml-token-contains-data-p nil offset)) |
| 2036 | (goto-char xmltok-start) |
| 2037 | (while (and (not pos) (< (point-min) (point))) |
| 2038 | (cond ((search-backward "<" nxml-prolog-end t) |
| 2039 | (nxml-move-outside-backwards) |
| 2040 | (save-excursion |
| 2041 | (while (< (point) last-tag-pos) |
| 2042 | (xmltok-forward) |
| 2043 | (when (and (not had-data) (nxml-token-contains-data-p)) |
| 2044 | (setq pos nil) |
| 2045 | (setq last-data-pos xmltok-start)) |
| 2046 | (let ((tem (nxml-paragraph-start-pos had-data 0))) |
| 2047 | (when tem (setq pos tem))))) |
| 2048 | (when (and (not had-data) last-data-pos (not pos)) |
| 2049 | (setq had-data t) |
| 2050 | (save-excursion |
| 2051 | (while (< (point) last-data-pos) |
| 2052 | (xmltok-forward)) |
| 2053 | (let ((tem (nxml-paragraph-start-pos had-data 0))) |
| 2054 | (when tem (setq pos tem))))) |
| 2055 | (setq last-tag-pos (point))) |
| 2056 | (t (goto-char (point-min)))))) |
| 2057 | (when pos (goto-char pos)))) |
| 2058 | |
| 2059 | (defun nxml-token-contains-data-p (&optional start end) |
| 2060 | (setq start (+ xmltok-start (or start 0))) |
| 2061 | (setq end (- (point) (or end 0))) |
| 2062 | (when (eq xmltok-type 'cdata-section) |
| 2063 | (setq start (max start (+ xmltok-start 9))) |
| 2064 | (setq end (min end (- (point) 3)))) |
| 2065 | (or (and (eq xmltok-type 'data) |
| 2066 | (eq start xmltok-start) |
| 2067 | (eq end (point))) |
| 2068 | (eq xmltok-type 'char-ref) |
| 2069 | (and (memq xmltok-type '(data cdata-section)) |
| 2070 | (< start end) |
| 2071 | (save-excursion |
| 2072 | (goto-char start) |
| 2073 | (re-search-forward "[^ \t\r\n]" end t))))) |
| 2074 | |
| 2075 | (defun nxml-paragraph-end-pos (had-data offset) |
| 2076 | "Return the position of the paragraph end if contained in the current token. |
| 2077 | Return nil if the current token does not contain the paragraph end. |
| 2078 | Only characters after OFFSET from the start of the token are eligible. |
| 2079 | HAD-DATA says whether there have been non-whitespace data characters yet." |
| 2080 | (cond ((not had-data) |
| 2081 | (cond ((memq xmltok-type '(data cdata-section)) |
| 2082 | (save-excursion |
| 2083 | (let ((end (point))) |
| 2084 | (goto-char (+ xmltok-start |
| 2085 | (max (if (eq xmltok-type 'cdata-section) |
| 2086 | 9 |
| 2087 | 0) |
| 2088 | offset))) |
| 2089 | (and (re-search-forward "[^ \t\r\n]" end t) |
| 2090 | (re-search-forward "^[ \t]*$" end t) |
| 2091 | (match-beginning 0))))) |
| 2092 | ((and (eq xmltok-type 'comment) |
| 2093 | (nxml-token-begins-line-p) |
| 2094 | (nxml-token-ends-line-p)) |
| 2095 | (save-excursion |
| 2096 | (let ((end (point))) |
| 2097 | (goto-char (+ xmltok-start (max 4 offset))) |
| 2098 | (when (re-search-forward "[^ \t\r\n]" (- end 3) t) |
| 2099 | (if (re-search-forward "^[ \t]*$" end t) |
| 2100 | (match-beginning 0) |
| 2101 | (goto-char (- end 3)) |
| 2102 | (skip-chars-backward " \t") |
| 2103 | (unless (bolp) |
| 2104 | (beginning-of-line 2)) |
| 2105 | (point)))))))) |
| 2106 | ((memq xmltok-type '(data space cdata-section)) |
| 2107 | (save-excursion |
| 2108 | (let ((end (point))) |
| 2109 | (goto-char (+ xmltok-start offset)) |
| 2110 | (and (re-search-forward "^[ \t]*$" end t) |
| 2111 | (match-beginning 0))))) |
| 2112 | ((and (memq xmltok-type '(start-tag |
| 2113 | end-tag |
| 2114 | empty-element |
| 2115 | comment |
| 2116 | processing-instruction |
| 2117 | entity-ref)) |
| 2118 | (nxml-token-begins-line-p) |
| 2119 | (nxml-token-ends-line-p)) |
| 2120 | (save-excursion |
| 2121 | (goto-char xmltok-start) |
| 2122 | (skip-chars-backward " \t") |
| 2123 | (point))) |
| 2124 | ((and (eq xmltok-type 'end-tag) |
| 2125 | (looking-at "[ \t]*$") |
| 2126 | (not (nxml-in-mixed-content-p t))) |
| 2127 | (save-excursion |
| 2128 | (or (search-forward "\n" nil t) |
| 2129 | (point-max)))))) |
| 2130 | |
| 2131 | (defun nxml-paragraph-start-pos (had-data offset) |
| 2132 | "Return the position of the paragraph start if contained in the current token. |
| 2133 | Return nil if the current token does not contain the paragraph start. |
| 2134 | Only characters before OFFSET from the end of the token are eligible. |
| 2135 | HAD-DATA says whether there have been non-whitespace data characters yet." |
| 2136 | (cond ((not had-data) |
| 2137 | (cond ((memq xmltok-type '(data cdata-section)) |
| 2138 | (save-excursion |
| 2139 | (goto-char (- (point) |
| 2140 | (max (if (eq xmltok-type 'cdata-section) |
| 2141 | 3 |
| 2142 | 0) |
| 2143 | offset))) |
| 2144 | (and (re-search-backward "[^ \t\r\n]" xmltok-start t) |
| 2145 | (re-search-backward "^[ \t]*$" xmltok-start t) |
| 2146 | (match-beginning 0)))) |
| 2147 | ((and (eq xmltok-type 'comment) |
| 2148 | (nxml-token-ends-line-p) |
| 2149 | (nxml-token-begins-line-p)) |
| 2150 | (save-excursion |
| 2151 | (goto-char (- (point) (max 3 offset))) |
| 2152 | (when (and (< (+ xmltok-start 4) (point)) |
| 2153 | (re-search-backward "[^ \t\r\n]" |
| 2154 | (+ xmltok-start 4) |
| 2155 | t)) |
| 2156 | (if (re-search-backward "^[ \t]*$" xmltok-start t) |
| 2157 | (match-beginning 0) |
| 2158 | (goto-char xmltok-start) |
| 2159 | (if (looking-at "<!--[ \t]*\n") |
| 2160 | (match-end 0) |
| 2161 | (skip-chars-backward " \t") |
| 2162 | (point)))))))) |
| 2163 | ((memq xmltok-type '(data space cdata-section)) |
| 2164 | (save-excursion |
| 2165 | (goto-char (- (point) offset)) |
| 2166 | (and (re-search-backward "^[ \t]*$" xmltok-start t) |
| 2167 | (match-beginning 0)))) |
| 2168 | ((and (memq xmltok-type '(start-tag |
| 2169 | end-tag |
| 2170 | empty-element |
| 2171 | comment |
| 2172 | processing-instruction |
| 2173 | entity-ref)) |
| 2174 | (nxml-token-ends-line-p) |
| 2175 | (nxml-token-begins-line-p)) |
| 2176 | (or (search-forward "\n" nil t) |
| 2177 | (point-max))) |
| 2178 | ((and (eq xmltok-type 'start-tag) |
| 2179 | (nxml-token-begins-line-p) |
| 2180 | (not (save-excursion |
| 2181 | (goto-char xmltok-start) |
| 2182 | (nxml-in-mixed-content-p nil)))) |
| 2183 | (save-excursion |
| 2184 | (goto-char xmltok-start) |
| 2185 | (skip-chars-backward " \t") |
| 2186 | ;; include any blank line before |
| 2187 | (or (and (eq (char-before) ?\n) |
| 2188 | (save-excursion |
| 2189 | (goto-char (1- (point))) |
| 2190 | (skip-chars-backward " \t") |
| 2191 | (and (bolp) (point)))) |
| 2192 | (point)))))) |
| 2193 | |
| 2194 | (defun nxml-token-ends-line-p () (looking-at "[ \t]*$")) |
| 2195 | |
| 2196 | (defun nxml-token-begins-line-p () |
| 2197 | (save-excursion |
| 2198 | (goto-char xmltok-start) |
| 2199 | (skip-chars-backward " \t") |
| 2200 | (bolp))) |
| 2201 | |
| 2202 | (defun nxml-in-mixed-content-p (endp) |
| 2203 | "Return non-nil if point is in mixed content. |
| 2204 | Point must be after an end-tag or before a start-tag. |
| 2205 | ENDP is t in the former case, nil in the latter." |
| 2206 | (let (matching-tag-pos) |
| 2207 | (cond ((not (run-hook-with-args-until-failure |
| 2208 | 'nxml-in-mixed-content-hook)) |
| 2209 | nil) |
| 2210 | ;; See if the matching tag does not start or end a line. |
| 2211 | ((condition-case nil |
| 2212 | (progn |
| 2213 | (setq matching-tag-pos |
| 2214 | (xmltok-save |
| 2215 | (if endp |
| 2216 | (and (nxml-scan-element-backward (point)) |
| 2217 | xmltok-start) |
| 2218 | (nxml-scan-element-forward (point))))) |
| 2219 | (and matching-tag-pos |
| 2220 | (save-excursion |
| 2221 | (goto-char matching-tag-pos) |
| 2222 | (not (if endp |
| 2223 | (progn |
| 2224 | (skip-chars-backward " \t") |
| 2225 | (bolp)) |
| 2226 | (looking-at "[ \t]*$")))))) |
| 2227 | (nxml-scan-error nil)) |
| 2228 | t) |
| 2229 | ;; See if there's data at the same level. |
| 2230 | ((let (start end) |
| 2231 | (if endp |
| 2232 | (setq start matching-tag-pos |
| 2233 | end (point)) |
| 2234 | (setq start (point) |
| 2235 | end matching-tag-pos)) |
| 2236 | (save-excursion |
| 2237 | (or (when start |
| 2238 | (goto-char start) |
| 2239 | (nxml-preceding-sibling-data-p)) |
| 2240 | (when end |
| 2241 | (goto-char end) |
| 2242 | (nxml-following-sibling-data-p))))) |
| 2243 | t) |
| 2244 | ;; Otherwise, treat as not mixed |
| 2245 | (t nil)))) |
| 2246 | |
| 2247 | (defun nxml-preceding-sibling-data-p () |
| 2248 | "Return non-nil if there is a previous sibling that is data." |
| 2249 | (let ((lim (max (- (point) nxml-mixed-scan-distance) |
| 2250 | nxml-prolog-end)) |
| 2251 | (level 0) |
| 2252 | found end) |
| 2253 | (xmltok-save |
| 2254 | (save-excursion |
| 2255 | (while (and (< lim (point)) |
| 2256 | (>= level 0) |
| 2257 | (not found) |
| 2258 | (progn |
| 2259 | (setq end (point)) |
| 2260 | (search-backward "<" lim t))) |
| 2261 | (nxml-move-outside-backwards) |
| 2262 | (save-excursion |
| 2263 | (xmltok-forward) |
| 2264 | (let ((prev-level level)) |
| 2265 | (cond ((eq xmltok-type 'end-tag) |
| 2266 | (setq level (1+ level))) |
| 2267 | ((eq xmltok-type 'start-tag) |
| 2268 | (setq level (1- level)))) |
| 2269 | (when (eq prev-level 0) |
| 2270 | (while (and (< (point) end) (not found)) |
| 2271 | (xmltok-forward) |
| 2272 | (when (memq xmltok-type '(data cdata-section char-ref)) |
| 2273 | (setq found t))))))))) |
| 2274 | found)) |
| 2275 | |
| 2276 | (defun nxml-following-sibling-data-p () |
| 2277 | (let ((lim (min (+ (point) nxml-mixed-scan-distance) |
| 2278 | (point-max))) |
| 2279 | (level 0) |
| 2280 | found) |
| 2281 | (xmltok-save |
| 2282 | (save-excursion |
| 2283 | (while (and (< (point) lim) |
| 2284 | (>= level 0) |
| 2285 | (nxml-tokenize-forward) |
| 2286 | (not found)) |
| 2287 | (cond ((eq xmltok-type 'start-tag) |
| 2288 | (setq level (1+ level))) |
| 2289 | ((eq xmltok-type 'end-tag) |
| 2290 | (setq level (1- level))) |
| 2291 | ((and (eq level 0) |
| 2292 | (memq xmltok-type '(data cdata-section char-ref))) |
| 2293 | (setq found t)))))) |
| 2294 | found)) |
| 2295 | |
| 2296 | ;;; Filling |
| 2297 | |
| 2298 | (defun nxml-do-fill-paragraph (arg) |
| 2299 | (let (fill-paragraph-function |
| 2300 | fill-prefix |
| 2301 | start end) |
| 2302 | (save-excursion |
| 2303 | (nxml-forward-paragraph) |
| 2304 | (setq end (point)) |
| 2305 | (nxml-backward-paragraph) |
| 2306 | (skip-chars-forward " \t\r\n") |
| 2307 | (setq start (point)) |
| 2308 | (beginning-of-line) |
| 2309 | (setq fill-prefix (buffer-substring-no-properties (point) start)) |
| 2310 | (when (and (not (nxml-get-inside (point))) |
| 2311 | (looking-at "[ \t]*<!--")) |
| 2312 | (setq fill-prefix (concat fill-prefix " "))) |
| 2313 | (fill-region-as-paragraph start end arg)) |
| 2314 | (skip-line-prefix fill-prefix) |
| 2315 | fill-prefix)) |
| 2316 | |
| 2317 | (defun nxml-newline-and-indent (soft) |
| 2318 | (delete-horizontal-space) |
| 2319 | (if soft (insert-and-inherit ?\n) (newline 1)) |
| 2320 | (nxml-indent-line)) |
| 2321 | |
| 2322 | |
| 2323 | ;;; Dynamic markup |
| 2324 | |
| 2325 | (defvar nxml-dynamic-markup-prev-pos nil) |
| 2326 | (defvar nxml-dynamic-markup-prev-lengths nil) |
| 2327 | (defvar nxml-dynamic-markup-prev-found-marker nil) |
| 2328 | (defvar nxml-dynamic-markup-prev-start-tags (make-hash-table :test 'equal)) |
| 2329 | |
| 2330 | (defun nxml-dynamic-markup-word () |
| 2331 | "Dynamically markup the word before point. |
| 2332 | This attempts to find a tag to put around the word before point based |
| 2333 | on the contents of the current buffer. The end-tag will be inserted at |
| 2334 | point. The start-tag will be inserted at or before the beginning of |
| 2335 | the word before point; the contents of the current buffer is used to |
| 2336 | decide where. |
| 2337 | |
| 2338 | It works in a similar way to \\[dabbrev-expand]. It searches first |
| 2339 | backwards from point, then forwards from point for an element whose |
| 2340 | content is a string which matches the contents of the buffer before |
| 2341 | point and which includes at least the word before point. It then |
| 2342 | copies the start- and end-tags from that element and uses them to |
| 2343 | surround the matching string before point. |
| 2344 | |
| 2345 | Repeating \\[nxml-dynamic-markup-word] immediately after successful |
| 2346 | \\[nxml-dynamic-markup-word] removes the previously inserted markup |
| 2347 | and attempts to find another possible way to do the markup." |
| 2348 | (interactive "*") |
| 2349 | (let (search-start-pos) |
| 2350 | (if (and (integerp nxml-dynamic-markup-prev-pos) |
| 2351 | (= nxml-dynamic-markup-prev-pos (point)) |
| 2352 | (eq last-command this-command) |
| 2353 | nxml-dynamic-markup-prev-lengths) |
| 2354 | (let* ((end-tag-open-pos |
| 2355 | (- nxml-dynamic-markup-prev-pos |
| 2356 | (nth 2 nxml-dynamic-markup-prev-lengths))) |
| 2357 | (start-tag-close-pos |
| 2358 | (- end-tag-open-pos |
| 2359 | (nth 1 nxml-dynamic-markup-prev-lengths))) |
| 2360 | (start-tag-open-pos |
| 2361 | (- start-tag-close-pos |
| 2362 | (nth 0 nxml-dynamic-markup-prev-lengths)))) |
| 2363 | (delete-region end-tag-open-pos nxml-dynamic-markup-prev-pos) |
| 2364 | (delete-region start-tag-open-pos start-tag-close-pos) |
| 2365 | (setq search-start-pos |
| 2366 | (marker-position nxml-dynamic-markup-prev-found-marker))) |
| 2367 | (clrhash nxml-dynamic-markup-prev-start-tags)) |
| 2368 | (setq nxml-dynamic-markup-prev-pos nil) |
| 2369 | (setq nxml-dynamic-markup-prev-lengths nil) |
| 2370 | (setq nxml-dynamic-markup-prev-found-marker nil) |
| 2371 | (goto-char |
| 2372 | (save-excursion |
| 2373 | (let* ((pos (point)) |
| 2374 | (word (progn |
| 2375 | (backward-word 1) |
| 2376 | (unless (< (point) pos) |
| 2377 | (error "No word to markup")) |
| 2378 | (buffer-substring-no-properties (point) pos))) |
| 2379 | (search (concat word "</")) |
| 2380 | done) |
| 2381 | (when search-start-pos |
| 2382 | (goto-char search-start-pos)) |
| 2383 | (while (and (not done) |
| 2384 | (or (and (< (point) pos) |
| 2385 | (or (search-backward search nil t) |
| 2386 | (progn (goto-char pos) nil))) |
| 2387 | (search-forward search nil t))) |
| 2388 | (goto-char (- (match-end 0) 2)) |
| 2389 | (setq done (nxml-try-copy-markup pos))) |
| 2390 | (or done |
| 2391 | (error (if (zerop (hash-table-count |
| 2392 | nxml-dynamic-markup-prev-start-tags)) |
| 2393 | "No possible markup found for `%s'" |
| 2394 | "No more markup possibilities found for `%s'") |
| 2395 | word))))))) |
| 2396 | |
| 2397 | (defun nxml-try-copy-markup (word-end-pos) |
| 2398 | (save-excursion |
| 2399 | (let ((end-tag-pos (point))) |
| 2400 | (when (and (not (nxml-get-inside end-tag-pos)) |
| 2401 | (search-backward "<" nil t) |
| 2402 | (not (nxml-get-inside (point)))) |
| 2403 | (xmltok-forward) |
| 2404 | (when (and (eq xmltok-type 'start-tag) |
| 2405 | (< (point) end-tag-pos)) |
| 2406 | (let* ((start-tag-close-pos (point)) |
| 2407 | (start-tag |
| 2408 | (buffer-substring-no-properties xmltok-start |
| 2409 | start-tag-close-pos)) |
| 2410 | (words |
| 2411 | (nreverse |
| 2412 | (split-string |
| 2413 | (buffer-substring-no-properties start-tag-close-pos |
| 2414 | end-tag-pos) |
| 2415 | "[ \t\r\n]+")))) |
| 2416 | (goto-char word-end-pos) |
| 2417 | (while (and words |
| 2418 | (re-search-backward (concat |
| 2419 | (regexp-quote (car words)) |
| 2420 | "\\=") |
| 2421 | nil |
| 2422 | t)) |
| 2423 | (setq words (cdr words)) |
| 2424 | (skip-chars-backward " \t\r\n")) |
| 2425 | (when (and (not words) |
| 2426 | (progn |
| 2427 | (skip-chars-forward " \t\r\n") |
| 2428 | (not (gethash (cons (point) start-tag) |
| 2429 | nxml-dynamic-markup-prev-start-tags))) |
| 2430 | (or (< end-tag-pos (point)) |
| 2431 | (< word-end-pos xmltok-start))) |
| 2432 | (setq nxml-dynamic-markup-prev-found-marker |
| 2433 | (copy-marker end-tag-pos t)) |
| 2434 | (puthash (cons (point) start-tag) |
| 2435 | t |
| 2436 | nxml-dynamic-markup-prev-start-tags) |
| 2437 | (setq nxml-dynamic-markup-prev-lengths |
| 2438 | (list (- start-tag-close-pos xmltok-start) |
| 2439 | (- word-end-pos (point)) |
| 2440 | (+ (- xmltok-name-end xmltok-start) 2))) |
| 2441 | (let ((name (xmltok-start-tag-qname))) |
| 2442 | (insert start-tag) |
| 2443 | (goto-char (+ word-end-pos |
| 2444 | (- start-tag-close-pos xmltok-start))) |
| 2445 | (insert "</" name ">") |
| 2446 | (setq nxml-dynamic-markup-prev-pos (point)))))))))) |
| 2447 | |
| 2448 | |
| 2449 | ;;; Character names |
| 2450 | |
| 2451 | (defvar nxml-char-name-ignore-case t) |
| 2452 | |
| 2453 | (defvar nxml-char-name-alist nil |
| 2454 | "Alist of character names. |
| 2455 | Each member of the list has the form (NAME CODE . NAMESET), |
| 2456 | where NAME is a string naming a character, NAMESET is a symbol |
| 2457 | identifying a set of names and CODE is an integer specifying the |
| 2458 | Unicode scalar value of the named character. |
| 2459 | The NAME will only be used for completion if NAMESET has |
| 2460 | a non-nil `nxml-char-name-set-enabled' property. |
| 2461 | If NAMESET does does not have `nxml-char-name-set-defined' property, |
| 2462 | then it must have a `nxml-char-name-set-file' property and `load' |
| 2463 | will be applied to the value of this property if the nameset |
| 2464 | is enabled.") |
| 2465 | |
| 2466 | (defvar nxml-char-name-table (make-hash-table :test 'eq) |
| 2467 | "Hash table for mapping char codes to names. |
| 2468 | Each key is a Unicode scalar value. |
| 2469 | Each value is a list of pairs of the form (NAMESET . NAME), |
| 2470 | where NAMESET is a symbol identifying a set of names, |
| 2471 | and NAME is a string naming a character.") |
| 2472 | |
| 2473 | (defvar nxml-autoload-char-name-set-list nil |
| 2474 | "List of char namesets that can be autoloaded.") |
| 2475 | |
| 2476 | (defun nxml-enable-char-name-set (nameset) |
| 2477 | (put nameset 'nxml-char-name-set-enabled t)) |
| 2478 | |
| 2479 | (defun nxml-disable-char-name-set (nameset) |
| 2480 | (put nameset 'nxml-char-name-set-enabled nil)) |
| 2481 | |
| 2482 | (defun nxml-char-name-set-enabled-p (nameset) |
| 2483 | (get nameset 'nxml-char-name-set-enabled)) |
| 2484 | |
| 2485 | (defun nxml-autoload-char-name-set (nameset file) |
| 2486 | (unless (memq nameset nxml-autoload-char-name-set-list) |
| 2487 | (setq nxml-autoload-char-name-set-list |
| 2488 | (cons nameset nxml-autoload-char-name-set-list))) |
| 2489 | (put nameset 'nxml-char-name-set-file file)) |
| 2490 | |
| 2491 | (defun nxml-define-char-name-set (nameset alist) |
| 2492 | "Define a set of character names. |
| 2493 | NAMESET is a symbol identifying the set. |
| 2494 | ALIST is a list where each member has the form (NAME CODE), |
| 2495 | where NAME is a string naming a character and code is an |
| 2496 | integer giving the Unicode scalar value of the character." |
| 2497 | (when (get nameset 'nxml-char-name-set-defined) |
| 2498 | (error "Nameset `%s' already defined" nameset)) |
| 2499 | (let ((iter alist)) |
| 2500 | (while iter |
| 2501 | (let* ((name-code (car iter)) |
| 2502 | (name (car name-code)) |
| 2503 | (code (cadr name-code))) |
| 2504 | (puthash code |
| 2505 | (cons (cons nameset name) |
| 2506 | (gethash code nxml-char-name-table)) |
| 2507 | nxml-char-name-table)) |
| 2508 | (setcdr (cdr (car iter)) nameset) |
| 2509 | (setq iter (cdr iter)))) |
| 2510 | (setq nxml-char-name-alist |
| 2511 | (nconc alist nxml-char-name-alist)) |
| 2512 | (put nameset 'nxml-char-name-set-defined t)) |
| 2513 | |
| 2514 | (defun nxml-get-char-name (code) |
| 2515 | (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list) |
| 2516 | (let ((names (gethash code nxml-char-name-table)) |
| 2517 | name) |
| 2518 | (while (and names (not name)) |
| 2519 | (if (nxml-char-name-set-enabled-p (caar names)) |
| 2520 | (setq name (cdar names)) |
| 2521 | (setq names (cdr names)))) |
| 2522 | name)) |
| 2523 | |
| 2524 | (defvar nxml-named-char-history nil) |
| 2525 | |
| 2526 | (defun nxml-insert-named-char (arg) |
| 2527 | "Insert a character using its name. |
| 2528 | The name is read from the minibuffer. |
| 2529 | Normally, inserts the character as a numeric character reference. |
| 2530 | With a prefix argument, inserts the character directly." |
| 2531 | (interactive "*P") |
| 2532 | (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list) |
| 2533 | (let ((name |
| 2534 | (let ((completion-ignore-case nxml-char-name-ignore-case)) |
| 2535 | (completing-read "Character name: " |
| 2536 | nxml-char-name-alist |
| 2537 | (lambda (member) |
| 2538 | (get (cddr member) 'nxml-char-name-set-enabled)) |
| 2539 | t |
| 2540 | nil |
| 2541 | 'nxml-named-char-history))) |
| 2542 | (alist nxml-char-name-alist) |
| 2543 | elt code) |
| 2544 | (while (and alist (not code)) |
| 2545 | (setq elt (assoc name alist)) |
| 2546 | (if (get (cddr elt) 'nxml-char-name-set-enabled) |
| 2547 | (setq code (cadr elt)) |
| 2548 | (setq alist (cdr (member elt alist))))) |
| 2549 | (when code |
| 2550 | (insert (if arg |
| 2551 | (or (decode-char 'ucs code) |
| 2552 | (error "Character %x is not supported by Emacs" |
| 2553 | code)) |
| 2554 | (format "&#x%X;" code)))))) |
| 2555 | |
| 2556 | (defun nxml-maybe-load-char-name-set (sym) |
| 2557 | (when (and (get sym 'nxml-char-name-set-enabled) |
| 2558 | (not (get sym 'nxml-char-name-set-defined)) |
| 2559 | (stringp (get sym 'nxml-char-name-set-file))) |
| 2560 | (load (get sym 'nxml-char-name-set-file)))) |
| 2561 | |
| 2562 | (defun nxml-toggle-char-ref-extra-display (arg) |
| 2563 | "Toggle the display of extra information for character references." |
| 2564 | (interactive "P") |
| 2565 | (let ((new (if (null arg) |
| 2566 | (not nxml-char-ref-extra-display) |
| 2567 | (> (prefix-numeric-value arg) 0)))) |
| 2568 | (when (not (eq new nxml-char-ref-extra-display)) |
| 2569 | (setq nxml-char-ref-extra-display new) |
| 2570 | (font-lock-flush)))) |
| 2571 | |
| 2572 | (put 'nxml-char-ref 'evaporate t) |
| 2573 | |
| 2574 | (defun nxml-char-ref-display-extra (start end n) |
| 2575 | (when nxml-char-ref-extra-display |
| 2576 | (let ((name (nxml-get-char-name n)) |
| 2577 | (glyph-string (and nxml-char-ref-display-glyph-flag |
| 2578 | (nxml-glyph-display-string n 'nxml-glyph))) |
| 2579 | ov) |
| 2580 | (when (or name glyph-string) |
| 2581 | (setq ov (make-overlay start end nil t)) |
| 2582 | (overlay-put ov 'category 'nxml-char-ref) |
| 2583 | (when name |
| 2584 | (overlay-put ov 'help-echo name)) |
| 2585 | (when glyph-string |
| 2586 | (overlay-put ov |
| 2587 | 'after-string |
| 2588 | (propertize glyph-string 'face 'nxml-glyph))))))) |
| 2589 | |
| 2590 | (defun nxml-clear-char-ref-extra-display (start end) |
| 2591 | (let ((ov (overlays-in start end))) |
| 2592 | (while ov |
| 2593 | (when (eq (overlay-get (car ov) 'category) 'nxml-char-ref) |
| 2594 | (delete-overlay (car ov))) |
| 2595 | (setq ov (cdr ov))))) |
| 2596 | |
| 2597 | |
| 2598 | (defun nxml-start-delimiter-length (type) |
| 2599 | (or (get type 'nxml-start-delimiter-length) |
| 2600 | 0)) |
| 2601 | |
| 2602 | (put 'cdata-section 'nxml-start-delimiter-length 9) |
| 2603 | (put 'comment 'nxml-start-delimiter-length 4) |
| 2604 | (put 'processing-instruction 'nxml-start-delimiter-length 2) |
| 2605 | (put 'start-tag 'nxml-start-delimiter-length 1) |
| 2606 | (put 'empty-element 'nxml-start-delimiter-length 1) |
| 2607 | (put 'partial-empty-element 'nxml-start-delimiter-length 1) |
| 2608 | (put 'entity-ref 'nxml-start-delimiter-length 1) |
| 2609 | (put 'char-ref 'nxml-start-delimiter-length 2) |
| 2610 | |
| 2611 | (defun nxml-end-delimiter-length (type) |
| 2612 | (or (get type 'nxml-end-delimiter-length) |
| 2613 | 0)) |
| 2614 | |
| 2615 | (put 'cdata-section 'nxml-end-delimiter-length 3) |
| 2616 | (put 'comment 'nxml-end-delimiter-length 3) |
| 2617 | (put 'processing-instruction 'nxml-end-delimiter-length 2) |
| 2618 | (put 'start-tag 'nxml-end-delimiter-length 1) |
| 2619 | (put 'empty-element 'nxml-end-delimiter-length 2) |
| 2620 | (put 'partial-empty-element 'nxml-end-delimiter-length 1) |
| 2621 | (put 'entity-ref 'nxml-end-delimiter-length 1) |
| 2622 | (put 'char-ref 'nxml-end-delimiter-length 1) |
| 2623 | |
| 2624 | (defun nxml-token-type-friendly-name (type) |
| 2625 | (or (get type 'nxml-friendly-name) |
| 2626 | (symbol-name type))) |
| 2627 | |
| 2628 | (put 'cdata-section 'nxml-friendly-name "CDATA section") |
| 2629 | (put 'processing-instruction 'nxml-friendly-name "processing instruction") |
| 2630 | (put 'entity-ref 'nxml-friendly-name "entity reference") |
| 2631 | (put 'char-ref 'nxml-friendly-name "character reference") |
| 2632 | |
| 2633 | ;; Only do this in loaddefs, so that if someone defines a different |
| 2634 | ;; alias in .emacs, loading this file afterwards does not clobber it. |
| 2635 | ;;;###autoload(defalias 'xml-mode 'nxml-mode) |
| 2636 | |
| 2637 | (provide 'nxml-mode) |
| 2638 | |
| 2639 | ;;; nxml-mode.el ends here |