Mercurial > urweb

comparison src/elisp/urweb-move.el @ 368:b6be16792584

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Removed handling of <,> as operators, for now
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Oct 2008 14:17:55 -0400
parents 527529a083d9
children 226c977faa9c
comparison
equal deleted inserted replaced
367:28d3d7210687 368:b6be16792584
71 71
72 (defvar urweb-op-prec 72 (defvar urweb-op-prec
73 (urweb-preproc-alist 73 (urweb-preproc-alist
74 '((("UNION" "INTERSECT" "EXCEPT") . 0) 74 '((("UNION" "INTERSECT" "EXCEPT") . 0)
75 (("AND" "OR") . 1) 75 (("AND" "OR") . 1)
76 ((">" ">=" "<>" "<" "<=" "=") . 4) 76 ((">=" "<>" "<=" "=") . 4)
77 (("+" "-" "^") . 6) 77 (("+" "-" "^") . 6)
78 (("/" "*" "%") . 7) 78 (("/" "*" "%") . 7)
79 (("NOT") 9))) 79 (("NOT") 9)))
80 "Alist of Ur/Web infix operators and their precedence.") 80 "Alist of Ur/Web infix operators and their precedence.")
81 81
221 ;; (save-excursion (urweb-backward-spaces) 221 ;; (save-excursion (urweb-backward-spaces)
222 ;; (if (eq (preceding-char) ?=) "=datatype" sym))) 222 ;; (if (eq (preceding-char) ?=) "=datatype" sym)))
223 (t sym))))))) 223 (t sym)))))))
224 224
225 225
226 (defun urweb-tag-matcher ()
227 "Seek back to a matching opener tag"
228 (let ((depth 0)
229 (done nil))
230 (while (and (not done) (search-backward ">" nil t))
231 (if (save-excursion (backward-char 1) (looking-at "/"))
232 (when (not (search-backward "<" nil t))
233 (setq done t))
234 (if (search-backward "<" nil t)
235 (if (looking-at "</")
236 (incf depth)
237 (if (= depth 0)
238 (setq done t)
239 (decf depth)))
240 (setq done t))))))
241
226 (defun urweb-backward-sexp (prec) 242 (defun urweb-backward-sexp (prec)
227 "Move one sexp backward if possible, or one char else. 243 "Move one sexp backward if possible, or one char else.
228 Returns t if the move indeed moved through one sexp and nil if not. 244 Returns t if the move indeed moved through one sexp and nil if not.
229 PREC is the precedence currently looked for." 245 PREC is the precedence currently looked for."
230 (let ((parse-sexp-lookup-properties t) 246 (let ((parse-sexp-lookup-properties t)
232 (urweb-backward-spaces) 248 (urweb-backward-spaces)
233 (let* ((op (urweb-backward-sym)) 249 (let* ((op (urweb-backward-sym))
234 (op-prec (urweb-op-prec op 'back)) 250 (op-prec (urweb-op-prec op 'back))
235 match) 251 match)
236 (cond 252 (cond
253 ((save-excursion (backward-char 5)
254 (looking-at "</xml>"))
255 (backward-char 6)
256 (urweb-tag-matcher)
257 (backward-char 1)
258 (urweb-backward-sexp prec))
237 ((not op) 259 ((not op)
238 (let ((point (point))) 260 (let ((point (point)))
239 (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1))) 261 (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
240 (if (/= point (point)) t (ignore-errors (backward-char 1)) nil))) 262 (if (/= point (point)) t (ignore-errors (backward-char 1)) nil)))
241 ;; stop as soon as precedence is smaller than `prec' 263 ;; stop as soon as precedence is smaller than `prec'
254 ((string-match urweb-sexp-head-symbols-re op) nil) 276 ((string-match urweb-sexp-head-symbols-re op) nil)
255 ;; if the op was not alphanum, then we still have to do the backward-sexp 277 ;; if the op was not alphanum, then we still have to do the backward-sexp
256 ;; this reproduces the usual backward-sexp, but it might be bogus 278 ;; this reproduces the usual backward-sexp, but it might be bogus
257 ;; in this case since !@$% is a perfectly fine symbol 279 ;; in this case since !@$% is a perfectly fine symbol
258 (t t))))) ;(or (string-match "\\sw" op) (urweb-backward-sexp prec)) 280 (t t))))) ;(or (string-match "\\sw" op) (urweb-backward-sexp prec))
281 ;; (when (save-excursion (backward-char 5) (looking-at "</xml>"))
282 ;; (backward-char 5)
283 ;; (urweb-tag-matcher)
284 ;; (backward-char)
285 ;; (urweb-backward-sexp prec)))
259 286
260 (defun urweb-forward-sexp (prec) 287 (defun urweb-forward-sexp (prec)
261 "Moves one sexp forward if possible, or one char else. 288 "Moves one sexp forward if possible, or one char else.
262 Returns T if the move indeed moved through one sexp and NIL if not." 289 Returns T if the move indeed moved through one sexp and NIL if not."
263 (let ((parse-sexp-lookup-properties t) 290 (let ((parse-sexp-lookup-properties t)
305 (dotimes (i count) 332 (dotimes (i count)
306 (unless (urweb-backward-sexp nil) 333 (unless (urweb-backward-sexp nil)
307 (goto-char point) 334 (goto-char point)
308 (error "Containing expression ends prematurely"))))))) 335 (error "Containing expression ends prematurely")))))))
309 336
337
310 (defun urweb-user-forward-sexp (&optional count) 338 (defun urweb-user-forward-sexp (&optional count)
311 "Like `forward-sexp' but tailored to the Ur/Web syntax." 339 "Like `forward-sexp' but tailored to the Ur/Web syntax."
312 (interactive "p") 340 (interactive "p")
313 (unless count (setq count 1)) 341 (unless count (setq count 1))
314 (urweb-with-ist 342 (urweb-with-ist
321 (error "Containing expression ends prematurely"))))))) 349 (error "Containing expression ends prematurely")))))))
322 350
323 ;;(defun urweb-forward-thing () 351 ;;(defun urweb-forward-thing ()
324 ;; (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1))) 352 ;; (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1)))
325 353
326 (defun urweb-backward-arg () (urweb-backward-sexp 1000)) 354 (defun urweb-backward-arg () (interactive) (urweb-backward-sexp 1000))
327 (defun urweb-forward-arg () (urweb-forward-sexp 1000)) 355 (defun urweb-forward-arg () (urweb-forward-sexp 1000))
328 356
329 357
330 (provide 'urweb-move) 358 (provide 'urweb-move)
331 359