Download
(require 'nxml-mode)
(define-generic-mode 'xquery-mode
'(("(:" . ":)") ("<!--" . "-->"))
'("xquery" "version" "encoding" "at" "module" "namespace" "child" "descendant" "parent" "attribute" "self" "descendant-or-self" "ancestor" "following-sibling" "preceding-sibling" "following" "preceding" "ancestor-or-self" "declare" "function" "option" "ordering" "ordered" "unordered" "default" "order" "external" "or" "and" "div" "idiv" "mod" "in" "construction" "satisfies" "return" "then" "else" "boundary-space" "base-uri" "preserve" "strip" "copy-namespaces" "no-preserve" "inherit" "no-inherit" "to" "where" "collation" "intersect" "union" "except" "as" "case" "instance" "of" "castable" "item" "element" "schema-element" "schema-attribute" "processing-instruction" "comment" "text" "empty" "import" "schema" "is" "eq" "ne" "gt" "ge" "lt" "le" "some" "every" "for" "let" "cast" "treat" "validate" "document-node" "document" "node" "if" "typeswitch" "by" "stable" "ascending" "descending" "greatest" "least" "variable")
'(("\\(\\$\\w+\\)" 1 font-lock-variable-name-face)
("\\(\\w*:?\\w+\\)\\s *(" 1 font-lock-function-name-face)
("\\(<\\)\\(/?\\)\\(\\w*\\)\\(:?\\)\\(\\w+\\).*?\\(/?\\)\\(>\\)"
(1 'nxml-tag-delimiter-face)
(2 'nxml-tag-slash-face)
(3 'nxml-element-prefix-face)
(4 'nxml-element-colon-face)
(5 'nxml-element-local-name-face)
(6 'nxml-tag-slash-face)
(7 'nxml-tag-delimiter-face)
)
("\\(\\w*\\)\\(:?\\)\\(\\w+\\)=\\([\"']\\)\\(.*?\\)\\([\"']\\)"
(1 'nxml-attribute-prefix-face)
(2 'nxml-attribute-colon-face)
(3 'nxml-attribute-local-name-face)
(4 'nxml-attribute-value-delimiter-face)
(5 'nxml-attribute-value-face)
(6 'nxml-attribute-value-delimiter-face))
("\\(/\\)\\(\\w*\\)\\(:?\\)\\(\\w+\\)"
(1 font-lock-constant-face)
(2 font-lock-constant-face)
(3 font-lock-constant-face)
(4 font-lock-constant-face)
)
("as\\s +\\(\\w*:?\\w+\\)"
(1 font-lock-type-face)
)
)
'(".xq\\'")
'(xquery-set-indent-function xquery-set-up-syntax-table)
"A Major mode for editing xquery."
)
(defun xquery-set-indent-function ()
"Set the indent function for xquery mode."
(setq nxml-prolog-end (point-min))
(setq nxml-scan-end (copy-marker (point-min) nil))
(set (make-local-variable 'indent-line-function) 'xquery-indent-line)
(make-local-variable 'forward-sexp-function)
(setq forward-sexp-function 'xquery-forward-sexp)
(local-set-key "/" 'nxml-electric-slash)
)
(defun xquery-forward-sexp (&optional arg)
"Xquery forward s-expresssion.
This function is not very smart, it tries to use
`nxml-forward-balanced-item' if it sees '>' or '<' characters in
the direction you are going, and uses the regular `forward-sexp'
otherwise. "
(if (> arg 0)
(progn
(if (looking-at "[ \t]*<")
(nxml-forward-balanced-item arg)
(let ((forward-sexp-function nil)) (forward-sexp arg))))
(if (looking-back ">[ \t]*")
(nxml-forward-balanced-item arg)
(let ((forward-sexp-function nil)) (forward-sexp arg))))
)
(defun xquery-set-up-syntax-table ()
"Allow the hypen character to be recognized as part of a xquery symbol."
(modify-syntax-entry ?- "w" (syntax-table))
(modify-syntax-entry ?/ "." (syntax-table))
(modify-syntax-entry ?\{ "(}" (syntax-table))
(modify-syntax-entry ?\} "){" (syntax-table))
(modify-syntax-entry ?\[ "(]" (syntax-table))
(modify-syntax-entry ?\] ")]" (syntax-table))
(modify-syntax-entry ?\< "(>1" (syntax-table))
(modify-syntax-entry ?\> ")<4" (syntax-table))
(modify-syntax-entry ?\( "()1" (syntax-table))
(modify-syntax-entry ?\) ")(4" (syntax-table))
)
(defun xquery-indent-line ()
"Indent current line as xquery code."
(interactive)
(let ((savep (> (current-column) (current-indentation)))
(indent (condition-case err (max (xquery-calculate-indentation) 0)
(error (message "%S" err)))))
(if savep
(save-excursion (indent-line-to indent))
(indent-line-to indent))))
(defvar xquery-start-block-regexp "[ \t]*\\((\|{\\|for\\|let\\|where\\|return\\|if\\|else\\|typeswitch\\|declare[ \t]+function\\|.*[({]$\\)"
"A regular expression which indicates that a xquery block is starting.")
(defvar xquery-flwr-block-regexp "[ \t]*\\(for\\|let\\|where\\|return\\|order\\|stable\\s *order\\)")
(defvar xquery-indent-size 2
"The size of each indent level.")
(defvar xquery-indent-debug nil)
(defun xquery-toggle-debug-indent ()
"Toggle the debug flag used in `xquery-calculate-indentation'. "
(interactive)
(setq xquery-indent-debug (not xquery-indent-debug))
(message (concat "xquery-indent-debug is " (if xquery-indent-debug "en" "dis") "abled"))
)
(defun xquery-calculate-indentation ()
"Return the column to which the current line should be indented."
(beginning-of-line)
(if (bobp)
0
(skip-chars-forward " \t")
(cond
((eq (get-text-property (point) 'face) 'font-lock-comment-face) (current-indentation))
((looking-at "\\(</?\\w\\|{\\)")
(if xquery-indent-debug
(message "xquery-indent-debug: xml constructor"))
(let ((nxml-prolog-end (point-min))
(nxml-scan-end (copy-marker (point-min) nil)))
(nxml-compute-indent)
))
((looking-at "}")
(if xquery-indent-debug
(message "xquery-indent-debug: }"))
(save-excursion
(backward-up-list)
(let ((cc (current-column)))
(beginning-of-line)
(if (looking-at xquery-start-block-regexp)
(current-indentation)
cc))))
((looking-at "else")
(if xquery-indent-debug
(message "xquery-indent-debug: else"))
(save-excursion
(xquery-previous-non-empty-line)
(- (current-indentation) xquery-indent-size)
))
((looking-at ")")
(if xquery-indent-debug
(message "xquery-indent-debug: )"))
(save-excursion
(backward-up-list)
(if (looking-back "\\w+\\s *")
(backward-word))
(current-column)
))
((save-excursion
(when
(and
(looking-at xquery-flwr-block-regexp)
(progn
(xquery-previous-non-empty-line)
(beginning-of-line)
(looking-at xquery-flwr-block-regexp)))
(if xquery-indent-debug
(message "xquery-indent-debug: nested flwr"))
(current-indentation)
)
))
((save-excursion
(xquery-previous-non-empty-line)
(beginning-of-line)
(when (looking-at xquery-start-block-regexp)
(if xquery-indent-debug
(message "xquery-indent-debug: first line in block"))
(+ xquery-indent-size (current-indentation))))
)
(t
(if xquery-indent-debug
(message "xquery-indent-debug: everyting else"))
(save-excursion (xquery-previous-non-empty-line) (current-indentation)))
)))
(defun xquery-previous-non-empty-line ()
"Move to the last non-empty line."
(re-search-backward "\\S " (point-min) t)
)
(provide 'xquery-mode)