Mercurial > emacs
diff lisp/textmodes/xml-lite.el @ 44168:68fd324f9f0f
(xml-lite-at-indentation-p): Move.
(xml-lite-in-string-p, xml-lite-looking-back-at, xml-lite-looking-at):
New functions.
(forward-xml-tag, backward-xml-tag, beginning-of-xml-tag)
(end-of-xml-tag): Remove.
(xml-lite-get-context): Better handling of comments.
(xml-lite-calculate-indent): Use xml-lite-in-string-p.
(xml-lite-parse-tag-backward): Rewrite.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 27 Mar 2002 00:06:19 +0000 |
parents | 055adf3412f7 |
children | e7a365c909ff |
line wrap: on
line diff
--- a/lisp/textmodes/xml-lite.el Tue Mar 26 15:27:42 2002 +0000 +++ b/lisp/textmodes/xml-lite.el Wed Mar 27 00:06:19 2002 +0000 @@ -4,7 +4,7 @@ ;; Author: Mike Williams <mdub@bigfoot.com> ;; Created: February 2001 -;; Version: $Revision: 1.24 $ +;; Version: $Revision: 1.28 $ ;; Keywords: xml ;; This file is part of GNU Emacs. @@ -99,6 +99,26 @@ (make-variable-buffer-local 'xml-lite-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))) + +(defun xml-lite-in-string-p (&optional limit) + "Determine whether point is inside a string." + (let (syntax-info) + (or limit + (setq limit (or (save-excursion + (re-search-backward "^[ \t]*<" nil t)) + (point-min)))) + (setq syntax-info (parse-partial-sexp limit (point))) + (if (nth 3 syntax-info) + (list (nth 3 syntax-info) (nth 8 syntax-info))))) + + ;; Parsing (defstruct (xml-lite-tag @@ -111,64 +131,88 @@ (if (> (skip-chars-forward "-._:A-Za-z0-9") 0) (buffer-substring-no-properties here (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 () "Get information about the parent tag." (let ((limit (point)) - (tag-type 'open) - (tag-start (search-backward "<" nil t)) - tag-end name name-end) + tag-type tag-start tag-end name name-end) + + (cond - (if (not tag-start) nil - (setq tag-end (search-forward ">" limit t)) - - ;; determine tag type + ((null (re-search-backward "[<>]" nil t))) + + ((= ?> (char-after)) ;--- found tag-end --- + (setq tag-end (1+ (point))) + (goto-char tag-end) + (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 + (ignore-errors (backward-sexp) (point)))))) + + ((= ?< (char-after)) ;--- found tag-start --- + (setq tag-start (point)) (goto-char (1+ tag-start)) (cond - - ((= ?? (char-after)) ; processing-instruction - (setq tag-type 'pi)) + ((xml-lite-looking-at "!--") ; comment + (setq tag-type 'comment + tag-end (search-forward "-->" nil t))) + ((xml-lite-looking-at "![CDATA[") ; cdata + (setq tag-type 'cdata + tag-end (search-forward "]]>" nil t))) + (t + (goto-char tag-start) + (setq tag-end + (ignore-errors (forward-sexp) (point)))))) - ((= ?! (char-after)) ; declaration - (setq tag-type 'decl) - (cond - ((looking-at "!--") ; comment - (setq tag-type 'comment - tag-end (search-forward "-->" nil t))) - ((looking-at "!\\[CDATA\\[") ; cdata - (setq tag-type 'cdata - tag-end (search-forward "]]>" nil t))) - (t - (ignore-errors - (goto-char tag-start) - (forward-sexp 1) - (setq tag-end (point)))))) - - ((= ?% (char-after)) ; JSP tag - (setq tag-type 'jsp - tag-end (search-forward "%>" nil t))) + ) + + (cond - ((= ?/ (char-after)) ; close-tag - (goto-char (+ 2 tag-start)) - (setq tag-type 'close - name (xml-lite-parse-tag-name) - name-end (point))) + ((or tag-type (null tag-start))) + + ((= ?! (char-after (1+ tag-start))) ; declaration + (setq tag-type 'decl)) + + ((= ?? (char-after (1+ tag-start))) ; processing-instruction + (setq tag-type 'pi)) + + ((= ?/ (char-after (1+ tag-start))) ; close-tag + (goto-char (+ 2 tag-start)) + (setq tag-type 'close + name (xml-lite-parse-tag-name) + name-end (point))) - (t - (setq tag-type 'open - name (xml-lite-parse-tag-name) - name-end (point)) - ;; check whether it's an empty tag - (if (and tag-end (eq ?/ (char-before (- tag-end 1)))) - (setq tag-type 'empty)))) + ((member ; JSP tags etc + (char-after (1+ tag-start)) + '(?% ?#)) + (setq tag-type 'unknown)) - (goto-char tag-start) - (xml-lite-make-tag tag-type tag-start tag-end name name-end)))) + (t + (goto-char (1+ tag-start)) + (setq tag-type 'open + name (xml-lite-parse-tag-name) + name-end (point)) + ;; check whether it's an empty tag + (if (and tag-end (eq ?/ (char-before (- tag-end 1)))) + (setq tag-type 'empty)))) -(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))) + (cond + (tag-start + (goto-char tag-start) + (xml-lite-make-tag tag-type tag-start tag-end name name-end))))) (defsubst xml-lite-inside-tag-p (tag-info &optional point) "Return true if TAG-INFO contains the POINT." @@ -185,8 +229,12 @@ The context is a list of tag-info structures. The last one is the tag immediately enclosing the current position." (let ((here (point)) - (level 0) + (ignore-depth 0) tag-info context) + ;; CONTEXT keeps track of the tag-stack + ;; IGNORE-DEPTH keeps track of the nesting level of point relative to the + ;; first (outermost) tag on the context. This is the number of + ;; enclosing start-tags we'll have to ignore. (save-excursion (while @@ -203,15 +251,22 @@ ;; start-tag ((eq (xml-lite-tag-type tag-info) 'open) - (setq level (1- level)) - (when (= level -1) + (setq ignore-depth (1- ignore-depth)) + (when (= ignore-depth -1) (setq context (cons tag-info context)) - (setq level 0))) + (setq ignore-depth 0))) ;; end-tag ((eq (xml-lite-tag-type tag-info) 'close) - (setq level (1+ level))) - + (setq ignore-depth (1+ ignore-depth))) + + ((eq (xml-lite-tag-type tag-info) 'comment) + ;; this comment may enclose things we thought were tags + (while (and context + (> (xml-lite-tag-end tag-info) + (xml-lite-tag-end (car context)))) + (setq context (cdr context)))) + ))) ;; return context @@ -249,13 +304,13 @@ ;; inside a tag ((xml-lite-inside-tag-p last-tag-info here) - (let ((syntax-info - (parse-partial-sexp (xml-lite-tag-start last-tag-info) - (point)))) + + (let ((in-string + (xml-lite-in-string-p (xml-lite-tag-start last-tag-info)))) (cond ;; inside a string - ((nth 3 syntax-info) - (goto-char (nth 8 syntax-info)) + (in-string + (goto-char (nth 1 in-string)) (1+ (current-column))) ;; if we have a tag-name, base indent on that ((and (xml-lite-tag-name-end last-tag-info) @@ -362,36 +417,6 @@ (insert-char ?/ arg)))) -;; Movement commands - -(defun forward-xml-tag (arg) - "Move forward ARG XML-tags." - (interactive "p") - (cond - ((> arg 0) - (search-forward ">" nil nil arg)) - ((< arg 0) - (search-backward "<" nil nil (- arg))) - )) - -(defun backward-xml-tag (arg) - "Move backward ARG XML-tags." - (interactive "p") - (forward-xml-tag (- arg))) - -(defun beginning-of-xml-tag () - "Move to the beginning of the current XML-tag." - (interactive) - (if (= ?< (char-after (point))) - (point) - (search-backward "<"))) - -(defun end-of-xml-tag () - "Move to the end of the current XML-tag." - (interactive) - (forward-xml-tag 1)) - - ;; Keymap (defvar xml-lite-mode-map