In nxml-mode, splice contents of elements into their containing elements by deleting their matched start and end tags. Mostly like sgml-delete-tag, but better.

xmlsplice.el

;;; xmlsplice.el --- Complex balanced tag manipulations in nXML mode.

;; Author: Ian Zimmerman <itz@buug.org>
;; Version: 2015.10.27

;; This file is NOT part of GNU Emacs.

;;; Commentary:

;; For now, this module defines a nXML command analogous to
;; sgml-delete-tag.  Later, other tag manipulations may be added.

;;; License:

;; 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 3 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(eval-when-compile
  (require 'cl))
(require 'nxml-mode)
(require 'rng-nxml)
(require 'skeleton)

(defun xmlsplice-delete-forward-tag ()
  "Delete tag following point, with no effect on the kill ring.
If that leaves an empty line where the tag was, delete the line.
Return a cons of the start of the deleted region and the number
of characters deleted."
  (let ((p (point))
        (nxml-sexp-element-flag nil)
        (was-at-indentation
         (save-excursion
           (skip-chars-backward " \t")
           (bolp))))
    (skip-chars-forward " \t\n")
    (forward-sexp 1)
    (let* ((do-delete-line
            (and was-at-indentation (looking-at "[ \t]*$")))
           (end
            (if do-delete-line (1+ (match-end 0)) (point))))
      (goto-char p)
      (if do-delete-line (forward-line 0))
      (prog1 (cons (point) (- end (point)))
        (delete-region (point) end)))))

(defsubst xmlsplice-forward-xmltok-type ()
  "Return the XML token type after point."
  (save-excursion
    (skip-chars-forward " \t\n")
    (xmltok-forward))
  xmltok-type)

(defsubst xmlsplice-end-tag-position ()
  "Return position of end tag paired to start tag after point."
  (save-excursion
    (goto-char (nxml-scan-element-forward (point)))
    (let ((nxml-sexp-element-flag nil))
      (forward-sexp -1))
    (point)))

(defsubst xmlsplice-start-tag-position ()
  "Return position of start tag paired to end tag after point."
  (save-excursion
    (let ((nxml-sexp-element-flag nil))
      (skip-chars-forward " \t\n")
      (forward-sexp 1)
      (goto-char (nxml-scan-element-backward (point)))
      (forward-sexp -1))
    (point)))

(defun xmlsplice-delete-matching-tags (start end move-to-start)
  "Delete two matching tags at START and END.
If MOVE-TO-START is non-nil, following the deletions, move point
to the spot where the start tag was, otherwise put it where the
end tag was."  
  (goto-char end)
  (let* ((res-end (xmlsplice-delete-forward-tag))
         (real-end (car res-end)))
    (goto-char start)
    (let* ((res-start (xmlsplice-delete-forward-tag))
           (real-start (car res-start))
           (real-start-len (cdr res-start))
           (goal
            (if move-to-start real-start
              (- real-end real-start-len))))
      (goto-char goal))))

(defun xmlsplice-splice-1 (&optional move-to-start)
  "Splice the contents of one element by deleting its tags.
The point must be at the less-than character of a tag (either the
starting or ending tag of the element to be spliced, or an empty
element tag), or before it with only blank characters in between
the two.

If MOVE-TO-START is non-nil, following the deletions, move point
to the spot where the start tag was, otherwise put it where the
end tag was."
  (case (xmlsplice-forward-xmltok-type)
    ('empty-element
     (xmlsplice-delete-forward-tag))
    ('start-tag
     (let ((start (point)) (end (xmlsplice-end-tag-position)))
       (xmlsplice-delete-matching-tags start end move-to-start)))
    ('end-tag
     (let ((end (point)) (start (xmlsplice-start-tag-position)))
       (xmlsplice-delete-matching-tags start end move-to-start)))
    (t
     (error "Not before a start or end tag or empty element"))))

;;;###autoload
(defun xmlsplice-splice (n)
  "Delete matched (start and end, or empty) tags of elements.
In effect, this \"splices\" the contents of the affected elements
into their containing elements, hence the name of the function.
The point must be at the less-than character of a tag (either the
starting or ending tag of the first element to be spliced, or an
empty element tag), or before it with only blank characters in
between the two.

Unless N (interactively, the numeric prefix arg) is zero, repeat
this for `abs N' elements.  The behavior following each deletion,
and thus the successive elements operated upon, depend on the
sign of N.

With positive N the point after each deletion is where the end
tag was.  As a consequence the next element selected is the one
*following* the just spliced one.

With negative N the point after each deletion is where the start
tag was.  As a consequence the next element selected is one
*nested inside* the just spliced one, if such there is."
  (interactive "*p")
  ;; do not touch if arg is 0
  (if (= 0 n) nil
    (let ((repeat-nested (< n 0)))
      (dotimes (v (abs n)) (xmlsplice-splice-1 repeat-nested)))))

(defsubst xmlsplice-make-qualified-tag (ns-tag)
  "Construct a namespace qualified tag.
NS-TAG should be a pair in the format returned by
'rng-match-possible-start-tag-names'."
  (let* ((tag (cdr ns-tag))
         (ns (symbol-name (car ns-tag)))
         (i (save-match-data (string-match ":" ns)))
         (qtag (if (= i 0) tag (concat (substring ns 0 i) ":" tag))))
    (intern qtag)))

(defun xmlsplice-tags-completion-list (ns-tags)
  "Construct a list of namespace qualified tags.
NS-TAGS should be a list in the format returned by
'rng-match-possible-start-tag-names'.  The result list contains
*unique* start tags as strings, suitable for minibuffer
completion commands."
  (let ((tlist nil))
    (mapc
     (lambda (ns-tag)
       (let ((tagsym (xmlsplice-make-qualified-tag ns-tag)))
         (add-to-list 'tlist tagsym nil #'eq)))
     ns-tags)
    (mapcar #'symbol-name tlist)))

(defun xmlsplice-valid-start-tags (p)
  "Return the list of valid start tags at position P."
  (save-excursion
    (goto-char p)
    (rng-set-state-after)
    (xmlsplice-tags-completion-list (rng-match-possible-start-tag-names))))

(defvar xmlsplice-wrap-tag-history nil
  "History list for `xmlsplice-minibuffer-read-tag'.")

(defun xmlsplice-minibuffer-read-tag ()
  "Read a tag to insert from the minibuffer, with completion."
  (completing-read
   "Tag: "                              ;prompt
   (xmlsplice-valid-start-tags (point)) ;collection
   nil                                  ;predicate
   nil                                  ;require-match
   nil                                  ;initial
   'xmlsplice-wrap-tag-history          ;hist
   nil                                  ;default
   t                                    ;inherit-input-method
   ))

(defconst xmlsplice-wrap-inline-skeleton
  '((xmlsplice-minibuffer-read-tag)
    "<" str " >" _ "</" str ">")
  "Skeleton for `xmlsplice-wrap-inline'.")

;;;###autoload
(defun xmlsplice-wrap-inline (&optional regions tag)
  "Wrap a pair of matching tags around some text following point.

This is done with a skeleton; see `skeleton-insert' for the
sematics of the optional arg REGIONS.  Interactively, REGIONS is
the numeric prefix arg.  If TAG is non-nil, it is bound to the
STR element of the skeleton and becomes the tag name to be
inserted.  That can only happen when called from a program.
Interactively, the skeleton itself prompts for the tag,
with completion based on `rng-match-possible-start-tag-names'.
Following the insertion, the point is left after the new end tag.

The tags are inserted assuming the new element is an inline one;
i.e. no implicit whitespace is added anywhere before, after or
between the tags."
  (interactive "*p\ni")
  (let ((skeleton-end-newline nil)
        (rng-validate-mode nil))
    (skeleton-insert xmlsplice-wrap-inline-skeleton regions tag)))

(defconst xmlsplice-wrap-block-skeleton
  '((xmlsplice-minibuffer-read-tag)
    "<" str " >" > "\n" > _ "\n</" str ">" > )
  "Skeleton for `xmlsplice-wrap-block'.")

;;;###autoload
(defun xmlsplice-wrap-block (&optional regions tag)
  "Wrap a pair of matching tags around some text following point.

This is done with a skeleton; see `skeleton-insert' for the
sematics of the optional arg REGIONS.  Interactively, REGIONS is
the numeric prefix arg.  If TAG is non-nil, it is bound to the
STR element of the skeleton and becomes the tag name to be
inserted.  That can only happen when called from a program.
Interactively, the skeleton itself prompts for the tag,
with completion based on `rng-match-possible-start-tag-names'.
Following the insertion, the point is left after the new end tag.

The tags are inserted assuming the new element is a block one;
i.e. an implicit newline is added anywhere before and after the
tags, and the wrapped text is reindented."
  (interactive "*p\ni")
  (let ((skeleton-end-newline t)
        (rng-validate-mode nil))
    (skeleton-insert xmlsplice-wrap-block-skeleton regions tag)))

(provide 'xmlsplice)

;;; xmlsplice.el ends here