Mercurial > hg > xemacs

comparison xquery-mode.el @ 78:0abfe9bf83a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 7b2c4ed36302
children
comparison
equal deleted inserted replaced
77:62fb1a21629a 78:0abfe9bf83a0
1 ;;; xquery-mode.el --- A simple mode for editing xquery programs
2 ;; Time-stamp: <2005-03-26 18:05:39 sacharya>
3
4 ;;; Copyright (C) 2005 Suraj Acharya
5
6 ;; Author: Suraj Acharya <sacharya@cs.indiana.edu>
7
8 ;; This file is not part of GNU Emacs.
9
10 ;; xquery-mode.el is free software; you can redistribute it
11 ;; and/or modify it under the terms of the GNU General Public License
12 ;; as published by the Free Software Foundation; either version 2, or
13 ;; (at your option) any later version.:
14
15 ;; This software is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26 ;;;
27
28 (require 'nxml-mode)
29 (require 'generic-mode)
30 ;;; Code:
31 (define-generic-mode 'xquery-mode
32 '(("(:" . ":)") ("!-" . "->"))
33 '("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") ;keywords
34 '(("\\(\\$\\w+\\)" 1 font-lock-variable-name-face) ;; \\(\\s_\\|\\w\\)
35 ("\\(\\w*:?\\w+\\)\\s *(" 1 font-lock-function-name-face)
36 ("\\(<\\)\\(/?\\)\\(\\w*\\)\\(:?\\)\\(\\w+\\).*?\\(/?\\)\\(>\\)"
37 (1 'nxml-tag-delimiter-face)
38 (2 'nxml-tag-slash-face)
39 (3 'nxml-element-prefix-face)
40 (4 'nxml-element-colon-face)
41 (5 'nxml-element-local-name-face)
42 (6 'nxml-tag-slash-face)
43 (7 'nxml-tag-delimiter-face)
44 )
45 ("\\(\\w*\\)\\(:?\\)\\(\\w+\\)=\\([\"']\\)\\(.*?\\)\\([\"']\\)"
46 (1 'nxml-attribute-prefix-face)
47 (2 'nxml-attribute-colon-face)
48 (3 'nxml-attribute-local-name-face)
49 (4 'nxml-attribute-value-delimiter-face)
50 (5 'nxml-attribute-value-face)
51 (6 'nxml-attribute-value-delimiter-face))
52 ("\\(/\\)\\(\\w*\\)\\(:?\\)\\(\\w+\\)"
53 (1 font-lock-constant-face)
54 (2 font-lock-constant-face)
55 (3 font-lock-constant-face)
56 (4 font-lock-constant-face)
57 )
58 ("as\\s +\\(\\w*:?\\w+\\)"
59 (1 font-lock-type-face)
60 )
61 ) ;font-lock-list
62 '(".xq[ml]?$") ;auto-mode-list
63 '(xquery-set-indent-function xquery-set-up-syntax-table) ;function list
64 "A Major mode for editing xquery."
65 )
66
67
68
69 (defun xquery-set-indent-function ()
70 "Set the indent function for xquery mode."
71 (setq nxml-prolog-end (point-min))
72 (setq nxml-scan-end (copy-marker (point-min) nil))
73 (set (make-local-variable 'indent-line-function) 'xquery-indent-line)
74 (make-local-variable 'forward-sexp-function)
75 (setq forward-sexp-function 'xquery-forward-sexp)
76 ;;(local-set-key "/" 'nxml-electric-slash)
77 )
78
79 (defun xquery-forward-sexp (&optional arg)
80 "Xquery forward s-expresssion.
81 This function is not very smart, it tries to use
82 `nxml-forward-balanced-item' if it sees '>' or '<' characters in
83 the direction you are going, and uses the regular `forward-sexp'
84 otherwise. "
85 (if (> arg 0)
86 (progn
87 (if (looking-at "[ \t]*<")
88 (nxml-forward-balanced-item arg)
89 (let ((forward-sexp-function nil)) (forward-sexp arg))))
90 (if (looking-back ">[ \t]*")
91 (nxml-forward-balanced-item arg)
92 (let ((forward-sexp-function nil)) (forward-sexp arg))))
93 )
94
95
96 (defun xquery-set-up-syntax-table ()
97 "Allow the hypen character to be recognized as part of a xquery symbol."
98 (modify-syntax-entry ?- "w" (syntax-table))
99 (modify-syntax-entry ?/ "." (syntax-table))
100 ;; set-up the syntax table correctly for parentheis type characters
101 (modify-syntax-entry ?\{ "(}" (syntax-table))
102 (modify-syntax-entry ?\} "){" (syntax-table))
103 (modify-syntax-entry ?\[ "(]" (syntax-table))
104 (modify-syntax-entry ?\] ")]" (syntax-table))
105 (modify-syntax-entry ?\( "()1" (syntax-table))
106 (modify-syntax-entry ?\) ")(4" (syntax-table))
107 ;;(modify-syntax-entry ?\< "(>" (syntax-table))
108 ;;(modify-syntax-entry ?\> ")<" (syntax-table))
109 ;; xquery comments are like (: :) -- handled above at mode decl
110 ;;(modify-syntax-entry ?\: ".23" (syntax-table))
111 )
112
113
114
115 (defun xquery-indent-line ()
116 "Indent current line as xquery code."
117 (interactive)
118 (let ((savep (> (current-column) (current-indentation)))
119 (indent (condition-case err (max (xquery-calculate-indentation) 0)
120 (error (message "%S" err)))))
121 (if savep
122 (save-excursion (indent-line-to indent))
123 (indent-line-to indent))))
124
125 (defvar xquery-start-block-regexp "[ \t]*\\((\|{\\|for\\|let\\|where\\|return\\|if\\|else\\|typeswitch\\|declare[ \t]+function\\|.*[({]$\\)"
126 "A regular expression which indicates that a xquery block is starting.")
127
128 (defvar xquery-flwr-block-regexp "[ \t]*\\(for\\|let\\|where\\|return\\|order\\|stable\\s *order\\)")
129
130 (defvar xquery-indent-size 2
131 "The size of each indent level.")
132
133 (defvar xquery-indent-debug nil)
134
135 (defun xquery-toggle-debug-indent ()
136 "Toggle the debug flag used in `xquery-calculate-indentation'. "
137 (interactive)
138 (setq xquery-indent-debug (not xquery-indent-debug))
139 (message (concat "xquery-indent-debug is " (if xquery-indent-debug "en" "dis") "abled"))
140 )
141
142 (defun xquery-calculate-indentation ()
143 "Return the column to which the current line should be indented."
144 (beginning-of-line)
145 (if (bobp)
146 0 ; First line is always non-indented
147 (skip-chars-forward " \t")
148 (cond
149 ;; do nothing if this is a comment
150 ((eq (get-text-property (point) 'face) 'font-lock-comment-face) (current-indentation))
151
152 ((looking-at "\\(</?\\w\\|{\\)") ;; xml constructor or enclosed expressions
153 (if xquery-indent-debug
154 (message "xquery-indent-debug: xml constructor"))
155 (let ((nxml-prolog-end (point-min))
156 (nxml-scan-end (copy-marker (point-min) nil)))
157 (nxml-compute-indent)
158 ))
159
160 ;; for close braces or else statements indent to the same level as the opening {
161 ((looking-at "}")
162 (if xquery-indent-debug
163 (message "xquery-indent-debug: }"))
164 (save-excursion
165 (backward-up-list)
166 (let ((cc (current-column)))
167 (beginning-of-line)
168 (if (looking-at xquery-start-block-regexp)
169 (current-indentation)
170 cc))))
171
172 ((looking-at "else")
173 (if xquery-indent-debug
174 (message "xquery-indent-debug: else"))
175 (save-excursion
176 (xquery-previous-non-empty-line)
177 (- (current-indentation) xquery-indent-size)
178 ))
179
180 ;; for close parens, indent to the start of the func call
181 ((looking-at ")")
182 (if xquery-indent-debug
183 (message "xquery-indent-debug: )"))
184 (save-excursion
185 (backward-up-list)
186 (if (looking-back "\\w+\\s *")
187 (backward-word))
188 (current-column)
189 ))
190
191 ;; order flwr expressions on the same column
192 ((save-excursion
193 (when
194 (and
195 (looking-at xquery-flwr-block-regexp)
196 (progn
197 (xquery-previous-non-empty-line)
198 (beginning-of-line)
199 (looking-at xquery-flwr-block-regexp)))
200 (if xquery-indent-debug
201 (message "xquery-indent-debug: nested flwr"))
202 (current-indentation)
203 )
204 ))
205
206 ;; if this is the first non-empty line after a block, indent xquery-indent-size chars relative to the block
207 ((save-excursion
208 (xquery-previous-non-empty-line)
209 (beginning-of-line)
210 (when (looking-at xquery-start-block-regexp)
211 (if xquery-indent-debug
212 (message "xquery-indent-debug: first line in block"))
213 (+ xquery-indent-size (current-indentation))))
214 )
215
216 ;; for everything else indent relative to the outer list
217 (t
218 (if xquery-indent-debug
219 (message "xquery-indent-debug: everyting else"))
220 (save-excursion (xquery-previous-non-empty-line) (current-indentation)))
221 )))
222
223 (when (featurep 'xemacs)
224 (unless (functionp 'looking-back)
225 ;; from GNU Emacs subr.el
226 (defun looking-back (regexp &optional limit greedy)
227 "Return non-nil if text before point matches regular expression
228 REGEXP.
229 Like `looking-at' except matches before point, and is slower.
230 LIMIT if non-nil speeds up the search by specifying a minimum
231 starting position, to avoid checking matches that would start
232 before LIMIT.
233 If GREEDY is non-nil, extend the match backwards as far as possible,
234 stopping when a single additional previous character cannot be part
235 of a match for REGEXP."
236 (let ((start (point))
237 (pos
238 (save-excursion
239 (and (re-search-backward (concat "\\(?:" regexp
240 "\\)\\=") limit t)
241 (point)))))
242 (if (and greedy pos)
243 (save-restriction
244 (narrow-to-region (point-min) start)
245 (while (and (> pos (point-min))
246 (save-excursion
247 (goto-char pos)
248 (backward-char 1)
249 (looking-at (concat "\\(?:" regexp
250 "\\)\\'"))))
251 (setq pos (1- pos)))
252 (save-excursion
253 (goto-char pos)
254 (looking-at (concat "\\(?:" regexp "\\)\\'")))))
255 (not (null pos))))))
256
257 (defun xquery-previous-non-empty-line ()
258 "Move to the last non-empty line."
259 (re-search-backward "\\S " (point-min) t)
260 )
261
262 (provide 'xquery-mode)
263
264 ;;; xquery-mode.el ends here