mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-24 07:20:37 +00:00
259 lines
8.4 KiB
EmacsLisp
259 lines
8.4 KiB
EmacsLisp
;;; xml-lite.el --- an indentation-engine for XML
|
||
|
||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||
|
||
;; Author: Mike Williams <mdub@bigfoot.com>
|
||
;; Created: February 2001
|
||
;; Keywords: xml
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation; either version 2 of the License, or
|
||
;; (at your option) any later version.
|
||
;;
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
;;
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||
;; Boston, MA 02111-1307, USA.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; This package provides a simple indentation engine for XML. It is
|
||
;; intended for use in situations where the full power of the popular PSGML
|
||
;; package (DTD parsing, syntax checking) is not required.
|
||
;;
|
||
;; xml-lite is designed to be used in conjunction with the default GNU
|
||
;; Emacs sgml-mode, to provide a lightweight XML-editing environment.
|
||
|
||
;;; Thanks:
|
||
;;
|
||
;; Jens Schmidt <Jens.Schmidt@oracle.com>
|
||
;; for his feedback and suggestions
|
||
|
||
;; PLEASE NOTE!
|
||
;; xml-lite is on it's way out, as functionality is merged into
|
||
;; sgml-mode.
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile (require 'cl))
|
||
(require 'sgml-mode)
|
||
|
||
|
||
;; Syntax analysis
|
||
|
||
(defsubst xml-lite-at-indentation-p ()
|
||
"Return true if point is at the first non-whitespace character on the line."
|
||
(save-excursion
|
||
(skip-chars-backward " \t")
|
||
(bolp)))
|
||
|
||
|
||
;; Parsing
|
||
|
||
(defstruct (xml-lite-tag
|
||
(:constructor xml-lite-make-tag (type start end name)))
|
||
type start end name)
|
||
|
||
(defsubst xml-lite-parse-tag-name ()
|
||
"Skip past a tag-name, and return the name."
|
||
(buffer-substring-no-properties
|
||
(point) (progn (skip-syntax-forward "w_") (point))))
|
||
|
||
(defsubst xml-lite-looking-back-at (s)
|
||
(let ((limit (max (- (point) (length s)) (point-min))))
|
||
(equal s (buffer-substring-no-properties limit (point)))))
|
||
|
||
(defsubst xml-lite-looking-at (s)
|
||
(let ((limit (min (+ (point) (length s)))))
|
||
(equal s (buffer-substring-no-properties (point) limit))))
|
||
|
||
(defun xml-lite-parse-tag-backward ()
|
||
"Parse an SGML tag backward, and return information about the tag.
|
||
Assume that parsing starts from within a textual context.
|
||
Leave point at the beginning of the tag."
|
||
(let (tag-type tag-start tag-end name)
|
||
(search-backward ">")
|
||
(setq tag-end (1+ (point)))
|
||
(cond
|
||
((xml-lite-looking-back-at "--") ; comment
|
||
(setq tag-type 'comment
|
||
tag-start (search-backward "<!--" nil t)))
|
||
((xml-lite-looking-back-at "]]") ; cdata
|
||
(setq tag-type 'cdata
|
||
tag-start (search-backward "<![CDATA[" nil t)))
|
||
(t
|
||
(setq tag-start
|
||
(with-syntax-table sgml-tag-syntax-table
|
||
(goto-char tag-end)
|
||
(backward-sexp)
|
||
(point)))
|
||
(goto-char (1+ tag-start))
|
||
(case (char-after)
|
||
(?! ; declaration
|
||
(setq tag-type 'decl))
|
||
(?? ; processing-instruction
|
||
(setq tag-type 'pi))
|
||
(?/ ; close-tag
|
||
(forward-char 1)
|
||
(setq tag-type 'close
|
||
name (xml-lite-parse-tag-name)))
|
||
((?% ?#) ; JSP tags etc
|
||
(setq tag-type 'unknown))
|
||
(t ; open or empty tag
|
||
(setq tag-type 'open
|
||
name (xml-lite-parse-tag-name))
|
||
(if (or (eq ?/ (char-before (- tag-end 1)))
|
||
(sgml-empty-tag-p name))
|
||
(setq tag-type 'empty))))))
|
||
(goto-char tag-start)
|
||
(xml-lite-make-tag tag-type tag-start tag-end name)))
|
||
|
||
(defsubst xml-lite-inside-tag-p (tag-info &optional point)
|
||
"Return true if TAG-INFO contains the POINT."
|
||
(let ((end (xml-lite-tag-end tag-info))
|
||
(point (or point (point))))
|
||
(or (null end)
|
||
(> end point))))
|
||
|
||
(defun xml-lite-get-context (&optional full)
|
||
"Determine the context of the current position.
|
||
If FULL is `empty', return even if the context is empty (i.e.
|
||
we just skipped over some element and got to a beginning of line).
|
||
If FULL is non-nil, parse back to the beginning of the buffer, otherwise
|
||
parse until we find a start-tag as the first thing on a line.
|
||
|
||
The context is a list of tag-info structures. The last one is the tag
|
||
immediately enclosing the current position."
|
||
(let ((here (point))
|
||
(ignore nil)
|
||
(context nil)
|
||
tag-info)
|
||
;; CONTEXT keeps track of the tag-stack
|
||
;; IGNORE keeps track of the nesting level of point relative to the
|
||
;; first (outermost) tag on the context. This is the list of
|
||
;; enclosing start-tags we'll have to ignore.
|
||
(skip-chars-backward " \t\n") ; Make sure we're not at indentation.
|
||
(while
|
||
(and (or ignore
|
||
(not (if full (eq full 'empty) context))
|
||
(not (xml-lite-at-indentation-p))
|
||
(and context
|
||
(/= (point) (xml-lite-tag-start (car context)))
|
||
(sgml-unclosed-tag-p (xml-lite-tag-name (car context)))))
|
||
(setq tag-info (ignore-errors (xml-lite-parse-tag-backward))))
|
||
|
||
;; This tag may enclose things we thought were tags. If so,
|
||
;; discard them.
|
||
(while (and context
|
||
(> (xml-lite-tag-end tag-info)
|
||
(xml-lite-tag-end (car context))))
|
||
(setq context (cdr context)))
|
||
|
||
(cond
|
||
|
||
;; inside a tag ...
|
||
((xml-lite-inside-tag-p tag-info here)
|
||
(push tag-info context))
|
||
|
||
;; start-tag
|
||
((eq (xml-lite-tag-type tag-info) 'open)
|
||
(cond
|
||
((null ignore)
|
||
(if (and context
|
||
(sgml-unclosed-tag-p (xml-lite-tag-name tag-info))
|
||
(eq t (compare-strings
|
||
(xml-lite-tag-name tag-info) nil nil
|
||
(xml-lite-tag-name (car context)) nil nil t)))
|
||
;; There was an implicit end-tag.
|
||
nil
|
||
(push tag-info context)))
|
||
((eq t (compare-strings (xml-lite-tag-name tag-info) nil nil
|
||
(car ignore) nil nil t))
|
||
(setq ignore (cdr ignore)))
|
||
(t
|
||
;; The open and close tags don't match.
|
||
(if (not sgml-xml-mode)
|
||
;; Assume the open tag is simply not closed.
|
||
(unless (sgml-unclosed-tag-p (xml-lite-tag-name tag-info))
|
||
(message "Unclosed tag <%s>" (xml-lite-tag-name tag-info)))
|
||
(message "Unmatched tags <%s> and </%s>"
|
||
(xml-lite-tag-name tag-info) (pop ignore))))))
|
||
|
||
;; end-tag
|
||
((eq (xml-lite-tag-type tag-info) 'close)
|
||
(if (sgml-empty-tag-p (xml-lite-tag-name tag-info))
|
||
(message "Spurious </%s>: empty tag" (xml-lite-tag-name tag-info))
|
||
(push (xml-lite-tag-name tag-info) ignore)))
|
||
))
|
||
|
||
;; return context
|
||
context))
|
||
|
||
(defun xml-lite-show-context (&optional full)
|
||
"Display the current context.
|
||
If FULL is non-nil, parse back to the beginning of the buffer."
|
||
(interactive "P")
|
||
(with-output-to-temp-buffer "*XML Context*"
|
||
(pp (save-excursion (xml-lite-get-context full)))))
|
||
|
||
|
||
;; Editing shortcuts
|
||
|
||
(defun xml-lite-insert-end-tag ()
|
||
"Insert an end-tag for the current element."
|
||
(interactive)
|
||
(let* ((context (save-excursion (xml-lite-get-context)))
|
||
(tag-info (car (last context)))
|
||
(type (and tag-info (xml-lite-tag-type tag-info))))
|
||
|
||
(cond
|
||
|
||
((null context)
|
||
(error "Nothing to close"))
|
||
|
||
;; inside a tag
|
||
((xml-lite-inside-tag-p tag-info)
|
||
(insert (cond
|
||
((eq type 'open) " />")
|
||
((eq type 'comment) " -->")
|
||
((eq type 'cdata) "]]>")
|
||
((eq type 'jsp) "%>")
|
||
((eq type 'pi) "?>")
|
||
(t ">"))))
|
||
|
||
;; inside an element
|
||
((eq type 'open)
|
||
(insert "</" (xml-lite-tag-name tag-info) ">")
|
||
(indent-according-to-mode))
|
||
|
||
(t
|
||
(error "Nothing to close")))))
|
||
|
||
(defun xml-lite-slash (arg)
|
||
"Insert ARG slash characters.
|
||
Behaves electrically if `xml-lite-electric-slash' is non-nil."
|
||
(interactive "p")
|
||
(cond
|
||
((not (and (eq (char-before) ?<) (= arg 1)))
|
||
(insert-char ?/ arg))
|
||
((eq xml-lite-electric-slash 'indent)
|
||
(insert-char ?/ 1)
|
||
(indent-according-to-mode))
|
||
((eq xml-lite-electric-slash 'close)
|
||
(delete-backward-char 1)
|
||
(xml-lite-insert-end-tag))
|
||
(t
|
||
(insert-char ?/ arg))))
|
||
|
||
(provide 'xml-lite)
|
||
|
||
;;; xml-lite.el ends here
|