comparison src/elisp/urweb-mode.el @ 374:1099d083a702

Indenting paren-nested SQL expressions
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Oct 2008 17:15:21 -0400
parents 008afab3a5ce
children d3de57ce4bca
comparison
equal deleted inserted replaced
373:008afab3a5ce 374:1099d083a702
173 (if (> depth 0) 173 (if (> depth 0)
174 (decf depth) 174 (decf depth)
175 (setq finished t))) 175 (setq finished t)))
176 ((looking-at "}") 176 ((looking-at "}")
177 (incf depth)) 177 (incf depth))
178 ((save-excursion (backward-char 1) (or (looking-at "=>") (looking-at "->"))) 178 ((save-excursion (backward-char 1) (or (looking-at "=>")
179 (looking-at "->")
180 (looking-at "<>")))
179 nil) 181 nil)
180 ((looking-at "<") 182 ((looking-at "<")
181 (setq finished t)) 183 (setq finished t))
182 ((looking-at ">") 184 ((looking-at ">")
183 (if (> depth 0) 185 (cond
184 (if (not (re-search-backward "<" nil t)) 186 ((> depth 0)
185 (setq finished t)) 187 (if (not (re-search-backward "<" nil t))
188 (setq finished t)))
189 (t
186 (progn (backward-char 4) 190 (progn (backward-char 4)
187 (setq answer (not (or 191 (setq answer (not (or
188 (looking-at "/xml") 192 (looking-at "/xml")
189 (looking-at "xml/")))) 193 (looking-at "xml/"))))
190 (setq finished t)))))) 194 (setq finished t)))))))
191 answer))) 195 answer)))
192 196
193 (defun amAttribute (face) 197 (defun amAttribute (face)
194 (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<"))) 198 (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<")))
195 nil 199 nil
511 (urweb-tag-matcher) 515 (urweb-tag-matcher)
512 (beginning-of-line) 516 (beginning-of-line)
513 (current-indentation))) 517 (current-indentation)))
514 518
515 (defconst urweb-sql-main-starters 519 (defconst urweb-sql-main-starters
516 '("SELECT" "INSERT" "UPDATE" "DELETE")) 520 '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE"))
517 521
518 (defconst urweb-sql-starters 522 (defconst urweb-sql-starters
519 (append urweb-sql-main-starters 523 (append urweb-sql-main-starters
520 '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET" 524 '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET"
521 "VALUES" "SET"))) 525 "VALUES" "SET")))
522 526
523 (defconst urweb-sql-main-starters-re 527 (defconst urweb-sql-main-starters-re
524 (urweb-syms-re urweb-sql-main-starters)) 528 (urweb-syms-re urweb-sql-main-starters))
525 (defconst urweb-sql-starters-re 529 (defconst urweb-sql-starters-re
526 (urweb-syms-re urweb-sql-starters)) 530 (urweb-syms-re urweb-sql-starters))
531
532 (defconst urweb-sql-main-starters-paren-re
533 (concat "(" urweb-sql-main-starters-re))
534
535 (defun urweb-in-sql ()
536 "Check if the point is in a block of SQL syntax."
537 (save-excursion
538 (let ((depth 0)
539 done)
540 (while (and (not done)
541 (re-search-backward "[()]" nil t))
542 (cond
543 ((looking-at ")")
544 (decf depth))
545 ((looking-at "(")
546 (if (looking-at urweb-sql-main-starters-paren-re)
547 (setq done t)
548 (incf depth)))))
549 (and (>= depth 0)
550 (looking-at urweb-sql-main-starters-paren-re)))))
551
552 (defun urweb-sql-depth ()
553 "Check if the point is in a block of SQL syntax.
554 Returns the paren nesting depth if so, and nil otherwise."
555 (save-excursion
556 (let ((depth 0)
557 done)
558 (while (and (not done)
559 (re-search-backward "[()]" nil t))
560 (cond
561 ((looking-at ")")
562 (decf depth))
563 ((looking-at "(")
564 (if (looking-at urweb-sql-main-starters-paren-re)
565 (setq done t)
566 (incf depth)))))
567 (max 0 depth))))
527 568
528 (defun urweb-calculate-indentation () 569 (defun urweb-calculate-indentation ()
529 (save-excursion 570 (save-excursion
530 (beginning-of-line) (skip-chars-forward "\t ") 571 (beginning-of-line) (skip-chars-forward "\t ")
531 (urweb-with-ist 572 (urweb-with-ist
577 (backward-sexp 1) 618 (backward-sexp 1)
578 (if (urweb-dangling-sym) 619 (if (urweb-dangling-sym)
579 (urweb-indent-default 'noindent) 620 (urweb-indent-default 'noindent)
580 (current-column)))) 621 (current-column))))
581 622
582 (and (looking-at urweb-sql-starters-re) 623 (and (or (looking-at "FROM") (looking-at urweb-sql-starters-re))
583 (save-excursion 624 (save-excursion
584 (and (re-search-backward urweb-sql-starters-re nil t) 625 (and (re-search-backward urweb-sql-starters-re nil t)
585 (if (looking-at urweb-sql-main-starters-re) 626 (if (looking-at urweb-sql-main-starters-re)
586 (current-column) 627 (current-column)
587 (current-indentation))))) 628 (current-indentation)))))
629
630 (and (urweb-in-sql)
631 (setq data (urweb-sql-depth))
632 (save-excursion
633 (re-search-backward urweb-sql-starters-re nil t)
634 (+ (current-column) 2 (* 2 data))))
588 635
589 (and (setq data (assoc sym urweb-close-paren)) 636 (and (setq data (assoc sym urweb-close-paren))
590 (urweb-indent-relative sym data)) 637 (urweb-indent-relative sym data))
591 638
592 (and (member sym urweb-starters-syms) 639 (and (member sym urweb-starters-syms)