Mercurial > hg > xemacs

comparison xquery-mode.el @ 25:0e4eb9db8a93 laptop

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
after debugging use with GNU Emacs
author ht
date Thu, 22 Oct 2015 14:28:54 +0100
parents
children 803e4156c7a0
comparison
equal deleted inserted replaced
7:5f3a215f12eb 25:0e4eb9db8a93
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