Mercurial > emacs
diff lisp/textmodes/xml-lite.el @ 43687:055adf3412f7
New file.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 04 Mar 2002 01:08:34 +0000 |
parents | |
children | 68fd324f9f0f |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/textmodes/xml-lite.el Mon Mar 04 01:08:34 2002 +0000 @@ -0,0 +1,435 @@ +;;; xml-lite.el --- an indentation-engine for XML + +;; Copyright (C) 2001 Mike Williams <mdub@bigfoot.com> + +;; Author: Mike Williams <mdub@bigfoot.com> +;; Created: February 2001 +;; Version: $Revision: 1.24 $ +;; 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. +;; +;; Updates will be made available at: +;; http://www.bigfoot.com/~mdub/software/xml-lite.el +;; +;; Note: the font-lock support that was in this package has been removed. + +;;; Thanks: +;; +;; Jens Schmidt <Jens.Schmidt@oracle.com> +;; for his feedback and suggestions + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'sgml-mode) +(require 'custom) + + +;; Variables + +(defgroup xml-lite nil + "Customizable variables for XML-Lite mode." + :group 'languages + ) + +(defcustom xml-lite-indent-offset 4 + "*Specifies the default indentation level for `xml-lite-indent-line'." + :type 'integer + :group 'xml-lite + ) + +(defcustom xml-lite-indent-comment-offset 5 + "*Specifies the indentation level for XML comments." + :type 'integer + :group 'xml-lite + ) + +(defcustom xml-lite-electric-slash 'close + "*If non-nil, inserting a '/' after a '<' behaves electrically. +If set to `indent', typing '</' just triggers reindentation. +If set to `close', typing '</' inserts an end-tag for the +enclosing XML element." + :type '(choice (const :tag "Indent" indent) + + (const :tag "Close" close) + (const :tag "No" nil)) + + :group 'xml-lite + ) + +(defcustom xml-lite-mode-line-string " XML" + "*String to display in the modeline when `xml-lite-mode' is active. +Set this to nil if you don't want a modeline indicator for xml-lite-mode." + :type 'string + :group 'xml-lite) + +(defcustom xml-lite-mode-hook nil + "*Hook called by `xml-lite-mode'." + :type 'hook + :group 'xml-lite) + +;;;###autoload +(defvar xml-lite-mode nil + "Non-nil if `xml-lite-mode' is enabled.") +(make-variable-buffer-local 'xml-lite-mode) + + +;; Parsing + +(defstruct (xml-lite-tag + (:constructor xml-lite-make-tag (type start end name name-end))) + type start end name name-end) + +(defsubst xml-lite-parse-tag-name () + "Skip past a tag-name, and return the name." + (let ((here (point))) + (if (> (skip-chars-forward "-._:A-Za-z0-9") 0) + (buffer-substring-no-properties here (point))))) + +(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) + + (if (not tag-start) nil + (setq tag-end (search-forward ">" limit t)) + + ;; determine tag type + (goto-char (1+ tag-start)) + (cond + + ((= ?? (char-after)) ; processing-instruction + (setq tag-type 'pi)) + + ((= ?! (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))) + + ((= ?/ (char-after)) ; 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)))) + + (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))) + +(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 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)) + (level 0) + tag-info context) + (save-excursion + + (while + (and (or (not context) + full + (not (xml-lite-at-indentation-p))) + (setq tag-info (xml-lite-parse-tag-backward))) + + (cond + + ;; inside a tag ... + ((xml-lite-inside-tag-p tag-info here) + (setq context (cons tag-info context))) + + ;; start-tag + ((eq (xml-lite-tag-type tag-info) 'open) + (setq level (1- level)) + (when (= level -1) + (setq context (cons tag-info context)) + (setq level 0))) + + ;; end-tag + ((eq (xml-lite-tag-type tag-info) 'close) + (setq level (1+ level))) + + ))) + + ;; 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 + + ;; no context + ((null context) + 0) + + ;; inside a comment + ((eq 'comment (xml-lite-tag-type last-tag-info)) + (goto-char (xml-lite-tag-start last-tag-info)) + (+ (current-column) xml-lite-indent-comment-offset)) + + ;; 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)))) + (cond + ;; inside a string + ((nth 3 syntax-info) + (goto-char (nth 8 syntax-info)) + (1+ (current-column))) + ;; if we have a tag-name, base indent on that + ((and (xml-lite-tag-name-end last-tag-info) + (progn + (goto-char (xml-lite-tag-name-end last-tag-info)) + (not (looking-at "[ \t]*$")))) + (1+ (current-column))) + ;; otherwise, add indent-offset + (t + (goto-char (xml-lite-tag-start last-tag-info)) + (+ (current-column) xml-lite-indent-offset))))) + + ;; inside an element + (t + ;; indent to start of tag + (let ((here (point)) + indent-col) + (goto-char (xml-lite-tag-start ref-tag-info)) + (setq indent-col (current-column)) + (goto-char here) + ;; add xml-lite-indent-offset, unless we're looking at the matching + ;; end-tag + (unless (and (eq (length context) 1) (looking-at "</")) + (setq indent-col (+ indent-col xml-lite-indent-offset))) + indent-col)) + + )))) + +(defun xml-lite-indent-line () + "Indent the current line as XML." + (interactive) + (let ((origin-point (point)) + bol-point indent-point + indent-col) + + ;; save beginning of line + (beginning-of-line) + (setq bol-point (point)) + ;; save current indent + (skip-chars-forward " \t") + (setq indent-point (point)) + + ;; calculate basic indent + (setq indent-col (xml-lite-calculate-indent)) + + (unless (eq (current-column) indent-col) + ;; re-indent, adjusting origin point for indentation change + (delete-region bol-point (point)) + (indent-to indent-col) + (setq origin-point (+ origin-point (- (point) indent-point)))) + + (if (> origin-point (point)) + (goto-char origin-point)) + + )) + + +;; 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 + + ((null context) + (error "Nothing to close")) + + ;; inside a tag + ((xml-lite-inside-tag-p tag-info) + (cond + ((eq type 'open) (insert " />")) + ((eq type 'comment) (insert " -->")) + ((eq type 'cdata) (insert "]]>")) + ((eq type 'jsp) (insert "%>")) + ((eq type 'pi) (insert "?>")) + (t (insert ">")))) + + ;; inside an element + ((eq type 'open) + (insert "</" (xml-lite-tag-name tag-info) ">") + (xml-lite-indent-line)) + + (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) + (xml-lite-indent-line)) + ((eq xml-lite-electric-slash 'close) + (delete-backward-char 1) + (xml-lite-insert-end-tag)) + (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 + +(defvar xml-lite-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\t" 'indent-for-tab-command) + (define-key map "\C-c/" 'xml-lite-insert-end-tag) + (define-key map "\C-c\C-s" 'xml-lite-show-context) + (define-key map "/" 'xml-lite-slash) + map) + "Key bindings for `xml-lite-mode'.") + + +;; Minor mode + +;;;###autoload +(define-minor-mode xml-lite-mode + "Toggle `xml-lite-mode'. +With ARG, enable xml-lite-mode if and only if ARG is positive. + +xml-lite-mode provides indentation for XML tags. The value of +`xml-lite-indent-offset' determines the amount of indentation. + +Key bindings: +\\{xml-lite-mode-map}" + nil ; initial value + " XML" ; mode indicator + 'xml-lite-mode-map ; keymap + (if xml-lite-mode + (progn + (if (eq major-mode 'fundamental-mode) + (sgml-mode)) + (make-local-variable 'indent-line-function) + (setq xml-lite-mode t + xml-lite-orig-indent-line-function indent-line-function + indent-line-function 'xml-lite-indent-line)) + (setq indent-line-function xml-lite-orig-indent-line-function)) + (force-mode-line-update)) + +(provide 'xml-lite) + +;;; xml-lite.el ends here