comparison lisp/textmodes/xml-lite.el @ 44242:84ff52bf6d2f

(xml-lite-get-context): Allow stopping even with an empty context. Don't save excursion any more. Ignore end-tags in sgml-empty-tags. Don't complain about unmatched start-tags in sgml-unclosed-tags. (xml-lite-get-context, xml-lite-calculate-indent) (xml-lite-insert-end-tag): Save excursion around xml-lite-get-context. (xml-lite-indent-line): Use back-to-indentation.

44241:600b7e53cf18

    (or (null end)
        (> end point))))

(defun xml-lite-get-context (&optional full)
  "Determine the context of the current position.
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)
        tag-info context)
    ;; 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.
    (save-excursion

      (while
          (and (or (not context)
		   ignore
                   full
                   (not (xml-lite-at-indentation-p)))
               (setq tag-info (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) (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.
		(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)
          (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 (xml-lite-get-context full))))


;; Indenting

(defun xml-lite-calculate-indent ()
  "Calculate the column to which this line should be indented."
  (let* ((here (point))
         (context (xml-lite-get-context))
         (ref-tag-info (car context))
         (last-tag-info (car (last context))))

    (save-excursion
      (cond

  "Indent the current line as XML."
  (interactive)
  (let* ((savep (point))
	 (indent-col
	  (save-excursion
	    (beginning-of-line)
	    (skip-chars-forward " \t")
	    (if (>= (point) savep) (setq savep nil))
	    ;; calculate basic indent
	    (xml-lite-calculate-indent))))
    (if savep
	(save-excursion (indent-line-to indent-col))
      (indent-line-to indent-col))))

;; Editing shortcuts

(defun xml-lite-insert-end-tag ()
  "Insert an end-tag for the current element."
  (interactive)
  (let* ((context (xml-lite-get-context))
         (tag-info (car (last context)))
         (type (and tag-info (xml-lite-tag-type tag-info))))

    (cond

44242:84ff52bf6d2f

    (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)))
	     (setq tag-info (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) (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 (member-ignore-case (xml-lite-tag-name tag-info)
					  sgml-unclosed-tags)
		(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 (and (not sgml-xml-mode)
		 (member-ignore-case (xml-lite-tag-name tag-info)
				     sgml-empty-tags))
	    (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)))))


;; Indenting

(defun xml-lite-calculate-indent ()
  "Calculate the column to which this line should be indented."
  (let* ((here (point))
         (context (save-excursion (xml-lite-get-context)))
         (ref-tag-info (car context))
         (last-tag-info (car (last context))))

    (save-excursion
      (cond

  "Indent the current line as XML."
  (interactive)
  (let* ((savep (point))
	 (indent-col
	  (save-excursion
	    (back-to-indentation)
	    (if (>= (point) savep) (setq savep nil))
	    (xml-lite-calculate-indent))))
    (if savep
	(save-excursion (indent-line-to indent-col))
      (indent-line-to indent-col))))

;; 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