Mercurial > urweb

comparison src/elisp/urweb-move.el @ 371:782ef3ad8c28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Crud auto-indented correctly
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Oct 2008 16:00:58 -0400
parents 4f75cc2e1373
children 040edfade639
comparison
equal deleted inserted replaced
370:4f75cc2e1373 371:782ef3ad8c28
180 180
181 (defun urweb-forward-sym-1 () 181 (defun urweb-forward-sym-1 ()
182 (or (/= 0 (skip-syntax-forward "'w_")) 182 (or (/= 0 (skip-syntax-forward "'w_"))
183 (/= 0 (skip-syntax-forward ".'")))) 183 (/= 0 (skip-syntax-forward ".'"))))
184 (defun urweb-forward-sym () 184 (defun urweb-forward-sym ()
185 (interactive)
185 (let ((sym (urweb-move-read (urweb-forward-sym-1)))) 186 (let ((sym (urweb-move-read (urweb-forward-sym-1))))
186 (cond 187 (cond
187 ((equal "op" sym) 188 ((equal "op" sym)
188 (urweb-forward-spaces) 189 (urweb-forward-spaces)
189 (concat "op " (or (urweb-move-read (urweb-forward-sym-1)) ""))) 190 (concat "op " (or (urweb-move-read (urweb-forward-sym-1)) "")))
204 205
205 (defun urweb-backward-sym-1 () 206 (defun urweb-backward-sym-1 ()
206 (or (/= 0 (skip-syntax-backward ".'")) 207 (or (/= 0 (skip-syntax-backward ".'"))
207 (/= 0 (skip-syntax-backward "'w_")))) 208 (/= 0 (skip-syntax-backward "'w_"))))
208 (defun urweb-backward-sym () 209 (defun urweb-backward-sym ()
210 (interactive)
209 (let ((sym (urweb-move-read (urweb-backward-sym-1)))) 211 (let ((sym (urweb-move-read (urweb-backward-sym-1))))
210 (when sym 212 (let ((result
211 ;; FIXME: what should we do if `sym' = "op" ? 213 (when sym
212 (let ((point (point))) 214 ;; FIXME: what should we do if `sym' = "op" ?
213 (urweb-backward-spaces) 215 (let ((point (point)))
214 (if (equal "op" (urweb-move-read (urweb-backward-sym-1))) 216 (urweb-backward-spaces)
215 (concat "op " sym) 217 (if (equal "op" (urweb-move-read (urweb-backward-sym-1)))
216 (goto-char point) 218 (concat "op " sym)
217 (cond 219 (goto-char point)
218 ((string= sym "=") (if (urweb-poly-equal-p) "=" "d=")) 220 (cond
219 ((string= sym "of") (if (urweb-nested-of-p) "of" "=of")) 221 ((string= sym "=") (if (urweb-poly-equal-p) "=" "d="))
220 ;; ((string= sym "datatype") 222 ((string= sym "of") (if (urweb-nested-of-p) "of" "=of"))
221 ;; (save-excursion (urweb-backward-spaces) 223 ;; ((string= sym "datatype")
222 ;; (if (eq (preceding-char) ?=) "=datatype" sym))) 224 ;; (save-excursion (urweb-backward-spaces)
223 (t sym))))))) 225 ;; (if (eq (preceding-char) ?=) "=datatype" sym)))
224 226 (t sym)))))))
227 (if (looking-at ">")
228 (substring result 1 nil)
229 result))))
230 ;; (if (save-excursion (backward-char 5) (looking-at "</xml>"))
231 ;; (progn
232 ;; (backward-char 5)
233 ;; (urweb-tag-matcher)
234 ;; (backward-char)
235 ;; (urweb-backward-sym))
236 ;; result))))
225 237
226 (defun urweb-tag-matcher () 238 (defun urweb-tag-matcher ()
227 "Seek back to a matching opener tag" 239 "Seek back to a matching opener tag"
228 (let ((depth 0) 240 (let ((depth 0)
229 (done nil)) 241 (done nil))
241 253
242 (defun urweb-backward-sexp (prec) 254 (defun urweb-backward-sexp (prec)
243 "Move one sexp backward if possible, or one char else. 255 "Move one sexp backward if possible, or one char else.
244 Returns t if the move indeed moved through one sexp and nil if not. 256 Returns t if the move indeed moved through one sexp and nil if not.
245 PREC is the precedence currently looked for." 257 PREC is the precedence currently looked for."
246 (let ((parse-sexp-lookup-properties t) 258 (let ((result (let ((parse-sexp-lookup-properties t)
247 (parse-sexp-ignore-comments t)) 259 (parse-sexp-ignore-comments t))
248 (urweb-backward-spaces) 260 (urweb-backward-spaces)
249 (let* ((op (urweb-backward-sym)) 261 (let* ((op (urweb-backward-sym))
250 (op-prec (urweb-op-prec op 'back)) 262 (op-prec (urweb-op-prec op 'back))
251 match) 263 match)
252 (cond 264 (cond
253 ((not op) 265 ((not op)
254 (let ((point (point))) 266 (let ((point (point)))
255 (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1))) 267 (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
256 (if (/= point (point)) t (ignore-errors (backward-char 1)) nil))) 268 (if (/= point (point)) t (ignore-errors (backward-char 1)) nil)))
257 ;; stop as soon as precedence is smaller than `prec' 269 ;; stop as soon as precedence is smaller than `prec'
258 ((and prec op-prec (>= prec op-prec)) nil) 270 ((and prec op-prec (>= prec op-prec)) nil)
259 ;; special rules for nested constructs like if..then..else 271 ;; special rules for nested constructs like if..then..else
260 ((and (or (not prec) (and prec op-prec)) 272 ((and (or (not prec) (and prec op-prec))
261 (setq match (second (assoc op urweb-close-paren)))) 273 (setq match (second (assoc op urweb-close-paren))))
262 (urweb-find-match-backward (concat "\\<" op "\\>") match)) 274 (urweb-find-match-backward (concat "\\<" op "\\>") match))
263 ;; don't back over open-parens 275 ;; don't back over open-parens
264 ((assoc op urweb-open-paren) nil) 276 ((assoc op urweb-open-paren) nil)
265 ;; infix ops precedence 277 ;; infix ops precedence
266 ((and prec op-prec) (< prec op-prec)) 278 ((and prec op-prec) (< prec op-prec))
267 ;; [ prec = nil ] a new operator, let's skip the sexps until the next 279 ;; [ prec = nil ] a new operator, let's skip the sexps until the next
268 (op-prec (while (urweb-move-if (urweb-backward-sexp op-prec))) t) 280 (op-prec (while (urweb-move-if (urweb-backward-sexp op-prec))) t)
269 ;; special symbols indicating we're getting out of a nesting level 281 ;; special symbols indicating we're getting out of a nesting level
270 ((string-match urweb-sexp-head-symbols-re op) nil) 282 ((string-match urweb-sexp-head-symbols-re op) nil)
271 ;; if the op was not alphanum, then we still have to do the backward-sexp 283 ;; if the op was not alphanum, then we still have to do the backward-sexp
272 ;; this reproduces the usual backward-sexp, but it might be bogus 284 ;; this reproduces the usual backward-sexp, but it might be bogus
273 ;; in this case since !@$% is a perfectly fine symbol 285 ;; in this case since !@$% is a perfectly fine symbol
274 (t t))))) ;(or (string-match "\\sw" op) (urweb-backward-sexp prec)) 286 (t t))))))
287 (if (save-excursion (backward-char 5) (looking-at "</xml>"))
288 (progn
289 (backward-char 5)
290 (urweb-tag-matcher)
291 (backward-char)
292 (urweb-backward-sexp prec))
293 result)))
275 294
276 (defun urweb-forward-sexp (prec) 295 (defun urweb-forward-sexp (prec)
277 "Moves one sexp forward if possible, or one char else. 296 "Moves one sexp forward if possible, or one char else.
278 Returns T if the move indeed moved through one sexp and NIL if not." 297 Returns T if the move indeed moved through one sexp and NIL if not."
279 (let ((parse-sexp-lookup-properties t) 298 (let ((parse-sexp-lookup-properties t)
338 (error "Containing expression ends prematurely"))))))) 357 (error "Containing expression ends prematurely")))))))
339 358
340 ;;(defun urweb-forward-thing () 359 ;;(defun urweb-forward-thing ()
341 ;; (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1))) 360 ;; (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1)))
342 361
343 (defun urweb-backward-arg () (urweb-backward-sexp 1000)) 362 (defun urweb-backward-arg () (interactive) (urweb-backward-sexp 1000))
344 (defun urweb-forward-arg () (urweb-forward-sexp 1000)) 363 (defun urweb-forward-arg () (interactive) (urweb-forward-sexp 1000))
345 364
346 365
347 (provide 'urweb-move) 366 (provide 'urweb-move)
348 367
349 ;;; urweb-move.el ends here 368 ;;; urweb-move.el ends here