From: Stefan Monnier Date: Wed, 27 Mar 2002 00:06:42 +0000 (+0000) Subject: (xml-lite-at-indentation-p): Move. X-Git-Tag: ttn-vms-21-2-B4~15962 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=63080afce880a4c067dfc2e7c5b04817070b82fe;p=emacs.git (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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e22b8a04880..1b567083265 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2002-03-26 Stefan Monnier + + * textmodes/xml-lite.el (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. + 2002-03-26 Juanma Barranquero * makefile.w32-in (WINS): Add the toolbar directory. @@ -34,13 +45,12 @@ * subr.el (macro-declaration-function): New function. Set the variable macro-declaration-function to it. - * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): + * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): Handle declarations in macro definitions. 2002-03-24 Eli Zaretskii - * facemenu.el (facemenu-get-face): Remove unused variable - `foreground'. + * facemenu.el (facemenu-get-face): Remove unused variable `foreground'. * enriched.el (enriched-face-ans): Support FACE of the form (:foreground COLOR) and (:background COLOR). diff --git a/lisp/textmodes/xml-lite.el b/lisp/textmodes/xml-lite.el index fcf01c8f82a..3b777479277 100644 --- a/lisp/textmodes/xml-lite.el +++ b/lisp/textmodes/xml-lite.el @@ -4,7 +4,7 @@ ;; Author: Mike Williams ;; Created: February 2001 -;; Version: $Revision: 1.24 $ +;; Version: $Revision: 1.28 $ ;; Keywords: xml ;; This file is part of GNU Emacs. @@ -98,6 +98,26 @@ Set this to nil if you don't want a modeline indicator for xml-lite-mode." "Non-nil if `xml-lite-mode' is enabled.") (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 @@ -111,64 +131,88 @@ Set this to nil if you don't want a modeline indicator for xml-lite-mode." (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) - (if (not tag-start) nil - (setq tag-end (search-forward ">" limit t)) + (cond - ;; 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))) - ((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))) - - ((= ?/ (char-after)) ; close-tag - (goto-char (+ 2 tag-start)) - (setq tag-type 'close - name (xml-lite-parse-tag-name) - name-end (point))) - + ((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 - (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)))) + (goto-char tag-start) + (setq tag-end + (ignore-errors (forward-sexp) (point)))))) + + ) + + (cond + + ((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))) + + ((member ; JSP tags etc + (char-after (1+ tag-start)) + '(?% ?#)) + (setq tag-type 'unknown)) + (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)))) + + (cond + (tag-start (goto-char tag-start) - (xml-lite-make-tag tag-type tag-start tag-end name name-end)))) - -(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))) + (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 @@ 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)) - (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 @@ immediately enclosing the current position." ;; 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 @@ If FULL is non-nil, parse back to the beginning of the buffer." ;; 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) @@ -361,36 +416,6 @@ Behaves electrically if `xml-lite-electric-slash' is non-nil." (t (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