sql-indent.el (102478B)
1 ;;; sql-indent.el --- Support for indenting code in SQL files. -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2015, 2017-2018 Free Software Foundation, Inc 4 5 ;; Author: Alex Harsanyi <AlexHarsanyi@gmail.com> 6 ;; Created: 27 Sep 2006 7 ;; Version: 1.7 8 ;; Keywords: languages sql 9 ;; Homepage: https://github.com/alex-hhh/emacs-sql-indent 10 ;; Package-Requires: ((cl-lib "0.5")) 11 ;; 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation; either version 3 of the License, or 15 ;; (at your option) any later version. 16 ;; 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 ;; 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 ;; 27 ;; `sqlind-minor-mode' is a minor mode that enables syntax-based indentation 28 ;; for `sql-mode' buffers: the TAB key indents the current line based on the 29 ;; SQL code on previous lines. To setup syntax-based indentation for every 30 ;; SQL buffer, add `sqlind-minor-mode' to `sql-mode-hook'. Indentation rules 31 ;; are flexible and can be customized to match your personal coding style. 32 ;; For more information, see the "sql-indent.org" file. 33 ;; 34 ;; The package also defines align rules so that the `align' function works for 35 ;; SQL statements, see `sqlind-align-rules'. 36 37 ;;; Code: 38 39 (require 'sql) 40 (require 'cl-lib) 41 42 ;;;; General setup 43 44 (defvar sqlind-syntax-table 45 (let ((table (make-syntax-table))) 46 ;; C-style comments /**/ (see elisp manual "Syntax Flags")) 47 (modify-syntax-entry ?/ ". 14" table) 48 (modify-syntax-entry ?* ". 23" table) 49 ;; double-dash starts comment 50 (modify-syntax-entry ?- ". 12b" table) 51 ;; newline and formfeed end coments 52 (modify-syntax-entry ?\n "> b" table) 53 (modify-syntax-entry ?\f "> b" table) 54 ;; single quotes (') quotes delimit strings 55 (modify-syntax-entry ?' "\"" table) 56 ;; backslash is no escape character 57 (modify-syntax-entry ?\\ "." table) 58 59 ;; the following are symbol constituents. Note that the dot '.' is more 60 ;; usefull as a symbol constituent than as a punctuation char. 61 62 (modify-syntax-entry ?_ "_" table) 63 (modify-syntax-entry ?. "_" table) 64 (modify-syntax-entry ?$ "_" table) 65 (modify-syntax-entry ?# "_" table) 66 (modify-syntax-entry ?% "_" table) 67 68 table) 69 "Syntax table used in `sql-mode' for indenting SQL code. 70 This is slightly different than the syntax table used for 71 navigation: some punctuation characters are made symbol 72 constituents so that syntactic navigation works over them.") 73 74 ;;;; Utilities 75 76 ;; The following routines perform rudimentary syntactical analysis of SQL 77 ;; code. The indentation engine decides how to indent based on what this code 78 ;; returns. The main function is `sqlind-syntax-of-line'. 79 ;; 80 ;; To examine the syntax of the current line, you can use the 81 ;; `sqlind-show-syntax-of-line'. This is only useful if you want to debug this 82 ;; package or are just curious. 83 84 (defconst sqlind-comment-start-skip "\\(--+\\|/\\*+\\)\\s *" 85 "Regexp to match the start of a SQL comment.") 86 87 (defconst sqlind-comment-end "\\*+/" 88 "Regexp to match the end of a multiline SQL comment.") 89 90 (defvar sqlind-comment-prefix "\\*+\\s " 91 "Regexp to match the line prefix inside comments. 92 This is used to indent multi-line comments.") 93 94 (defsubst sqlind-in-comment-or-string (pos) 95 "Return non nil if POS is inside a comment or a string. 96 We actually return \\='string if POS is inside a string, 97 \\='comment if POS is inside a comment, nil otherwise." 98 (syntax-ppss-context (syntax-ppss pos))) 99 100 (defun sqlind-backward-syntactic-ws () 101 "Move point backwards over whitespace and comments. 102 Leave point on the first character which is not syntactic 103 whitespace, or at the beginning of the buffer." 104 (let ((done nil)) 105 (while (not done) 106 (skip-chars-backward " \t\n\r\f\v") 107 (unless (eq (point) (point-min)) 108 (forward-char -1)) 109 (let ((pps (syntax-ppss (point)))) 110 (if (nth 4 pps) ; inside a comment? 111 (goto-char (nth 8 pps)) ; move to comment start than repeat 112 (setq done t))))) 113 (point)) 114 115 (defun sqlind-forward-syntactic-ws () 116 "Move point forward over whitespace and comments. 117 Leave point at the first character which is not syntactic 118 whitespace, or at the end of the buffer." 119 ;; if we are inside a comment, move to the comment start and scan 120 ;; from there. 121 (let ((pps (syntax-ppss (point)))) 122 (when (nth 4 pps) 123 (goto-char (nth 8 pps)))) 124 (let ((done nil)) 125 (while (not done) 126 (skip-chars-forward " \t\n\r\f\v") 127 (cond ((looking-at sqlind-comment-start-skip) (forward-comment 1)) 128 ;; a slash ("/") by itself is a SQL*plus directive and 129 ;; counts as whitespace 130 ((looking-at "/\\s *$") (goto-char (match-end 0))) 131 (t (setq done t))))) 132 (point)) 133 134 (defun sqlind-search-backward (start regexp limit) 135 "Search for REGEXP from START backward until LIMIT. 136 Finds a match that is not inside a comment or string, moves point 137 to the match and returns it. If no match is found, point is moved 138 to LIMIT and nil is returned." 139 (goto-char start) 140 (let ((done nil)) 141 (while (and (not done) 142 (re-search-backward regexp limit 'noerror)) 143 (when (sqlind-same-level-statement (point) start) 144 (setq done (point)))) 145 done)) 146 147 (defsubst sqlind-match-string (pos) 148 "Return the match data at POS in the current buffer. 149 This is similar to `match-data', but the text is fetched without 150 text properties and it is conveted to lower case." 151 (let ((start (match-beginning pos)) 152 (end (match-end pos))) 153 (when (and start end) 154 (downcase (buffer-substring-no-properties start end))))) 155 156 (defsubst sqlind-labels-match (lb1 lb2) 157 "Return t when LB1 equals LB2 or LB1 is an empty string. 158 This is used to compare start/end block labels where the end 159 block label might be empty." 160 (or (string= lb1 lb2) 161 (string= lb1 ""))) 162 163 (defun sqlind-same-level-statement (point start) 164 "Return t if POINT is at the same syntactic level as START. 165 This means that POINT is at the same nesting level and not inside 166 a string or comment." 167 (save-excursion 168 (let ((ppss-point (syntax-ppss point)) 169 (ppss-start (syntax-ppss start))) 170 (and (equal (nth 3 ppss-point) (nth 3 ppss-start)) ; string 171 (equal (nth 4 ppss-point) (nth 4 ppss-start)) ; comment 172 (= (nth 0 ppss-point) (nth 0 ppss-start)))))) ; same nesting 173 174 (defun sqlind-column-definition-start (pos limit) 175 "Find the beginning of a column definition in a select statement. 176 POS is the current position of the line to be indented, assumed 177 to be in a \\='select-column-continuation syntax. 178 179 LIMIT is the limit of the search, the beginning of the select 180 statement." 181 (save-excursion 182 (goto-char pos) 183 (catch 'found 184 (while (re-search-backward "," limit 'noerror) 185 (when (sqlind-same-level-statement (point) limit) 186 (forward-char 1) 187 (sqlind-forward-syntactic-ws) 188 (throw 'found (point)))) 189 ;; nothing was found in (while ...) so try to find the first column definition. 190 (goto-char limit) 191 (forward-sexp) 192 (sqlind-forward-syntactic-ws) 193 (point)))) 194 195 (defun sqlind-syntax (context) 196 "Return the most specific syntax of CONTEXT. 197 See `sqlind-syntax-of-line' for the definition of CONTEXT." 198 (when context 199 (caar context))) 200 201 (defun sqlind-syntax-symbol (context) 202 "Return the syntax symbol for the most specific syntax of CONTEXT. 203 See `sqlind-syntax-of-line' for the definition of CONTEXT." 204 (when context 205 (let ((syntax-part (caar context))) 206 (if (symbolp syntax-part) 207 syntax-part 208 (car syntax-part))))) 209 210 (defun sqlind-syntax-keyword (context) 211 "Return the syntax keyword for the most specific syntax of CONTEXT. 212 This is used for complex syntax symbols like \\='(in-block case 213 \"\"), in that case, it will return the \\='case symbol. See 214 `sqlind-syntax-of-line' for the definition of CONTEXT." 215 (when context 216 (let ((syntax-part (caar context))) 217 (if (symbolp syntax-part) 218 nil ; no KEYWORD 219 (nth 1 syntax-part))))) 220 221 (defun sqlind-anchor-point (context) 222 "Return the anchor point for the most specifc syntax of CONTEXT. 223 See `sqlind-syntax-of-line' for the definition of CONTEXT." 224 (when context 225 (cdar context))) 226 227 (defun sqlind-outer-context (context) 228 "Return the outer context from CONTEXT. 229 See `sqlind-syntax-of-line' for the definition of CONTEXT." 230 (when context 231 (cdr context))) 232 233 (defun sqlind-find-context (syntax-symbol context) 234 "Find SYNTAX-SYMBOL in the CONTEXT chain. 235 CONTEXT chain is a list of (SYNTAX-SYMBOL . ANCHOR), as returned 236 by `sqlind-syntax-of-line'. The function finds the fist element 237 which matches the specified syntax symbol and returns the list 238 from that point. 239 240 See `sqlind-indentation-syntax-symbols' for the possible syntax 241 symbols and their meaning." 242 (cond ((null context) 243 nil) 244 ((eq syntax-symbol (sqlind-syntax-symbol context)) 245 context) 246 (t 247 (sqlind-find-context syntax-symbol (sqlind-outer-context context))))) 248 249 (defun sqlind-looking-at-begin-transaction () 250 "Return t if the point is on a \"begin transaction\" statement." 251 (and (looking-at "begin") 252 (save-excursion 253 (forward-word 1) 254 (sqlind-forward-syntactic-ws) 255 (looking-at "transaction\\>\\|work\\>\\|;")))) 256 257 ;;;; Syntactic analysis of SQL code 258 259 ;;;;; Find the beginning of the current statement 260 261 (defconst sqlind-sqlplus-directive 262 (concat ;; SET is handled in a special way, to avoid conflicts with the SET 263 ;; keyworkd in updated clauses 264 "\\(^set\\s-+\\w+\\(\\s-+[^=].*\\)?$\\)\\|\\(^" 265 (regexp-opt '("column" "rem" "define" "spool" "prompt" 266 "clear" "compute" "whenever" "@" "@@" "start") 267 t) 268 "\\)\\b") 269 "Match an SQL*Plus directive at the beginning of a line. 270 A directive always stands on a line by itself -- we use that to 271 determine the statement start in SQL*Plus scripts.") 272 273 (defconst sqlind-sqlite-directive 274 "^[.].*?\\>" 275 "Match an SQLite directive at the beginning of a line. 276 A directive always stands on a line by itself -- we use that to 277 determine the statement start in SQLite scripts.") 278 279 (defconst sqlind-ms-directive 280 (concat 281 "\\(^set\\s-+\\(\\w\\|\\s_\\)+\\s-+\\(on\\|off\\)\\)\\|\\(^" 282 (regexp-opt '("use" "go" "declare") t) 283 "\\)\\b") 284 "Match an MS SQL Sever directive at the beginning of a line.") 285 286 (defun sqlind-beginning-of-directive () 287 "Return the position of an SQL directive, or nil. 288 We will never move past one of these in our scan. We also assume 289 they are one-line only directives." 290 (let ((rx (cl-case (and (boundp 'sql-product) sql-product) 291 (ms sqlind-ms-directive) 292 (sqlite sqlind-sqlite-directive) 293 (oracle sqlind-sqlplus-directive) 294 (t nil)))) 295 (when rx 296 (save-excursion 297 (when (re-search-backward rx nil 'noerror) 298 (forward-line 1) 299 (point)))))) 300 301 (defvar sqlind-search-limit nil 302 "Limit of search when looking for syntactic elements. 303 This variable is dynamically bound.") 304 305 (defun sqlind-beginning-of-statement-1 (limit) 306 "Return the position of a block start, or nil. 307 But don't go before LIMIT." 308 (save-excursion 309 (catch 'done 310 (while (> (point) (or limit (point-min))) 311 (when (re-search-backward ";\\|:=\\|\\_<\\(declare\\|\\(begin\\(\\(\\s-+not\\)?\\s-+atomic\\)?\\)\\|cursor\\|for\\|while\\|loop\\|if\\|then\\|else\\|elsif\\|elseif\\)\\_>\\|)\\|\\$\\$" 312 limit 'noerror) 313 (unless (sqlind-in-comment-or-string (point)) 314 (let ((candidate-pos (match-end 0))) 315 (cond ((looking-at ")") 316 ;; Skip parenthesis expressions, we don't want to find one 317 ;; of the keywords inside one of them and think this is a 318 ;; statement start. 319 (progn (forward-char 1) (forward-sexp -1))) 320 ((looking-at "cursor\\|for") 321 (unless (eq sql-product 'postgres) 322 (throw 'done (point)))) 323 ((looking-at "while") 324 (throw 'done (point))) 325 ((looking-at "declare") 326 (when (eq sql-product 'postgres) 327 (throw 'done (point)))) 328 ((looking-at "else?if") 329 ;; statement begins at the start of the keyword 330 (throw 'done (point))) 331 ((looking-at "then\\|else") 332 ;; then and else start statements when they are inside 333 ;; blocks, not expressions. 334 (sqlind-backward-syntactic-ws) 335 (when (looking-at ";") 336 ;; Statement begins after the keyword 337 (throw 'done candidate-pos))) 338 ((looking-at "if") 339 (when (sqlind-good-if-candidate) 340 ;; statement begins at the start of the keyword 341 (throw 'done (point)))) 342 ((looking-at ":=") 343 ;; assignment statements start at the assigned variable 344 (sqlind-backward-syntactic-ws) 345 (forward-sexp -1) 346 (throw 'done (point))) 347 ((looking-at "\\$\\$") 348 (when (eq sql-product 'postgres) 349 (sqlind-forward-syntactic-ws) 350 (throw 'done (point)))) 351 ((sqlind-looking-at-begin-transaction) 352 ;; This is a "begin transaction" call, statement begins 353 ;; at "begin", see #66 354 (throw 'done (point))) 355 ((not (sqlind-in-comment-or-string (point))) 356 (throw 'done candidate-pos)))))))))) 357 358 (defun sqlind-beginning-of-statement () 359 "Move point to the beginning of the current statement." 360 (interactive) 361 362 (goto-char 363 (or 364 ;; If we are inside a paranthesis expression, the start is the start of 365 ;; that expression. 366 (let ((ppss (syntax-ppss (point)))) 367 (when (> (nth 0 ppss) 0) 368 (nth 1 ppss))) 369 ;; Look for an ordinary statement start 370 (or (sqlind-beginning-of-statement-1 sqlind-search-limit) 371 ;; Fall back on the search limit 372 sqlind-search-limit) 373 ;; ... or point-min 374 (point-min))) 375 376 ;; a loop keyword might be part of an "end loop" statement, in that case, 377 ;; the statement starts with the "end" keyword. we use skip-syntax-backward 378 ;; so we won't skip over a semicolon (;) 379 (let ((pos (point))) 380 (skip-syntax-backward "w") 381 (if (looking-at "loop") 382 (progn 383 (forward-word -1) 384 (if (looking-at "\\bend\\b") 385 (goto-char (match-beginning 0)) 386 (goto-char pos))) 387 (goto-char pos))) 388 389 ;; now skip over any whitespace and comments until we find the first 390 ;; character that is program code. 391 (sqlind-forward-syntactic-ws)) 392 393 ;;;;; Find the syntax and beginning of the current block 394 395 (defconst sqlind-end-statement-regexp 396 "\\_<end\\_>\\(?:[ \t\n\r\f]*\\)\\(if\\_>\\|loop\\_>\\|case\\_>\\)?\\(?:[ \t\n\r\f]*\\)\\([a-z0-9_]+\\)?" 397 "Match an end of statement. 398 Matches a string like \"end if|loop|case MAYBE-LABEL\".") 399 400 (defvar sqlind-end-stmt-stack nil 401 "Stack of end-of-statement positions. 402 This is used by the sqlind-maybe-* functions to skip over SQL 403 programming blocks. This variable is dynamically bound.") 404 405 (defun sqlind-maybe-end-statement () 406 "Look for SQL end statements return t if found one. 407 If (point) is at an end statement, add it to the 408 `sqlind-end-stmt-stack' and return t, otherwise return nil. 409 410 See also `sqlind-beginning-of-block'" 411 (when (looking-at sqlind-end-statement-regexp) 412 (prog1 t ; make sure we return t 413 (let ((kind (or (sqlind-match-string 1) "")) 414 (label (or (sqlind-match-string 2) ""))) 415 (push (list (point) (if (equal kind "") nil (intern kind)) label) 416 sqlind-end-stmt-stack))))) 417 418 (defun sqlind-maybe-then-statement () 419 "Find the corresponding start block for a \"then\" statement. 420 When (point) is on a \"then\" statement, find the corresponding 421 start of the block and report its syntax. This code will skip 422 over nested statements to determine the actual start. 423 424 Only keywords in program code are matched, not the ones inside 425 expressions. 426 427 See also `sqlind-beginning-of-block'" 428 (when (looking-at "then") 429 (prog1 t ; make sure we return t 430 (let ((start-pos (point))) 431 432 ;; a then keyword at the begining of a line is a block start 433 (when (null sqlind-end-stmt-stack) 434 (save-excursion 435 (back-to-indentation) 436 (when (eq (point) start-pos) 437 (throw 'finished (list 'in-block 'then ""))))) 438 439 ;; if it is not at the beginning of a line, the beginning of 440 ;; the statement is the block start 441 (ignore-errors (forward-char -1)) 442 (sqlind-beginning-of-statement) 443 ;; a then keyword only starts a block when it is part of an 444 ;; if, case/when or exception statement 445 (cond 446 ((looking-at "\\(<<[a-z0-9_]+>>\\)?\\(?:[ \t\n\r\f]*\\)\\(\\(?:els\\)?if\\)\\_>") 447 (let ((if-label (sqlind-match-string 1)) 448 (if-kind (intern (sqlind-match-string 2)))) ; can be if or elsif 449 (setq if-label (if if-label (substring if-label 2 -2) "")) 450 (if (null sqlind-end-stmt-stack) 451 (throw 'finished (list 'in-block if-kind if-label)) 452 ;; "if" blocks (but not "elsif" blocks) need to be 453 ;; ended with "end if" 454 (when (eq if-kind 'if) 455 (cl-destructuring-bind (pos kind label) 456 (pop sqlind-end-stmt-stack) 457 (unless (and (eq kind 'if) 458 (sqlind-labels-match label if-label)) 459 (throw 'finished 460 (list 'syntax-error 461 "bad closing for if block" (point) pos)))))))) 462 ((looking-at "\\(<<[a-z0-9_]+>>\\)?\\(?:[ \t\n\r\f]*\\)case\\_>") 463 ;; find the nearest when block, but only if there are no 464 ;; end statements in the stack 465 (let ((case-label (sqlind-match-string 1))) 466 (setq case-label 467 (if case-label (substring case-label 2 -2) "")) 468 (if (null sqlind-end-stmt-stack) 469 (save-excursion 470 (when (sqlind-search-backward start-pos "\\_<when\\_>" (point)) 471 (throw 'finished (list 'in-block 'case case-label)))) 472 ;; else 473 (cl-destructuring-bind (pos kind label) 474 (pop sqlind-end-stmt-stack) 475 (unless (and (eq kind 'case) 476 (sqlind-labels-match label case-label)) 477 (throw 'finished 478 (list 'syntax-error 479 "bad closing for case block" (point) pos))))))) 480 ((looking-at "exception\\_>") 481 ;; an exception statement is a block start only if we have 482 ;; no end statements in the stack 483 (when (null sqlind-end-stmt-stack) 484 (throw 'finished (list 'in-block 'exception "")))) 485 (t ; restore position if we didn't do anything 486 (goto-char start-pos) 487 nil)))))) 488 489 (defun sqlind-good-if-candidate () 490 "Return non-nil if point is on an actual if statement. 491 We try to avoid false positives, like \"end if\" or the various 492 \"drop STUFF if exists\" variants." 493 (and (looking-at "if") 494 (save-excursion 495 (sqlind-backward-syntactic-ws) 496 (forward-word -1) 497 ;; we don't want to match an "end if", and things like "drop index if 498 ;; exists..." and "create index if not exist..." 499 (not (looking-at "end\\|schema\\|table\\|view\\|index\\|constraint\\|type\\|trigger\\|procedure\\|function\\|routine\\|package\\|body\\|extension"))))) 500 501 (defun sqlind-maybe-if-statement () 502 "If (point) is on an IF statement, report its syntax." 503 (when (sqlind-good-if-candidate) 504 (cond ((null sqlind-end-stmt-stack) 505 (throw 'finished (list 'in-block 'if ""))) 506 (t 507 (cl-destructuring-bind (pos kind _label) 508 (pop sqlind-end-stmt-stack) 509 (unless (eq kind 'if) 510 (throw 'finshed 511 (list 'syntax-error 512 "bad closing for if block" (point) pos)))))))) 513 514 (defun sqlind-maybe-case-statement () 515 "If (point) is on a case statement." 516 (when (looking-at "case") 517 (save-excursion 518 (sqlind-backward-syntactic-ws) 519 (forward-word -1) 520 (unless (looking-at "end") ; we don't want to match an "end case" here 521 (if (null sqlind-end-stmt-stack) 522 (throw 'finished (list 'in-block 'case "")) 523 (cl-destructuring-bind (pos kind _label) 524 (pop sqlind-end-stmt-stack) 525 (unless (or (not kind) (eq kind 'case)) 526 (throw 'finished 527 (list 'syntax-error 528 "bad closing for case block" (point) pos))))))))) 529 530 (defun sqlind-maybe-else-statement () 531 "If (point) is on an ELSE statement, report its syntax. 532 Only keywords in program code are matched, not the ones inside 533 expressions. 534 535 See also `sqlind-beginning-of-block'" 536 ;; an else statement is only a block start if the `sqlind-end-stmt-stack' is 537 ;; empty, otherwise, we don't do anything. 538 (when (and (looking-at "els\\(e\\|if\\)") 539 (null sqlind-end-stmt-stack)) 540 (throw 'finished (list 'in-block (intern (sqlind-match-string 0)) "")))) 541 542 (defun sqlind-maybe-loop-statement () 543 "If (point) is on a LOOP statement, report its syntax. 544 Only keywords in program code are matched, not the ones inside 545 expressions. 546 547 See also `sqlind-beginning-of-block'" 548 (when (looking-at "loop") 549 (prog1 t ; make sure we return t 550 (sqlind-beginning-of-statement) 551 ;; note that we might have found a loop in an "end loop;" statement. 552 (or (sqlind-maybe-end-statement) 553 (progn 554 (let ((posn (point))) 555 (unless (looking-at "<<") ;; whe're inside an label. 556 (forward-word -1) 557 (back-to-indentation)) 558 (let ((loop-label (if (looking-at "<<\\([a-z0-9_]+\\)>>") 559 (sqlind-match-string 1) ""))) 560 (goto-char posn) 561 ;; start of loop. this always starts a block, we only check if 562 ;; the labels match 563 (if (null sqlind-end-stmt-stack) 564 (throw 'finished (list 'in-block 'loop loop-label)) 565 (cl-destructuring-bind (pos kind label) 566 (pop sqlind-end-stmt-stack) 567 (unless (and (eq kind 'loop) 568 (sqlind-labels-match label loop-label)) 569 (throw 'finished 570 (list 'syntax-error 571 "bad closing for loop block" (point) pos)))))))))))) 572 573 (defun sqlind-maybe-begin-statement () 574 "Return the syntax of a \"begin\" statement. 575 If (point) is on a \"begin\" statement, report its syntax. Only 576 keywords in program code are matched, not the ones inside 577 expressions. 578 579 See also `sqlind-beginning-of-block'" 580 (when (and (looking-at "begin") (not (sqlind-looking-at-begin-transaction))) 581 ;; a begin statement starts a block unless it is the first begin in a 582 ;; procedure over which we need to skip it. 583 (prog1 t ; make sure we return t 584 (let* ((saved-pos (point)) 585 (begin-label (save-excursion 586 (sqlind-beginning-of-statement) 587 (if (looking-at "<<\\([a-z0-9_]+\\)>>\\_>") 588 (sqlind-match-string 1) ""))) 589 (previous-block (save-excursion 590 (ignore-errors (forward-char -1)) 591 (cons (sqlind-beginning-of-block) (point)))) 592 (previous-block-kind (nth 0 previous-block))) 593 594 (goto-char saved-pos) 595 (when (null sqlind-end-stmt-stack) 596 (throw 'finished 597 (cond ((memq previous-block-kind '(toplevel declare-statement)) 598 (list 'in-begin-block 'toplevel-block begin-label)) 599 ((and (listp previous-block-kind) 600 (eq (nth 0 previous-block-kind) 'defun-start)) 601 (list 'in-begin-block 'defun (nth 1 previous-block-kind))) 602 ((and (listp previous-block-kind) 603 (memq (nth 0 previous-block-kind) '(package package-body))) 604 (list 'in-begin-block 'package (nth 1 previous-block-kind))) 605 (t 606 (list 'in-begin-block nil begin-label))))) 607 608 (cl-destructuring-bind (pos kind label) (pop sqlind-end-stmt-stack) 609 (cond 610 (kind 611 (throw 'finished 612 (list 'syntax-error "bad closing for begin block" (point) pos))) 613 614 ((not (equal begin-label "")) 615 ;; we have a begin label. In this case it must match the end 616 ;; label 617 (unless (equal begin-label label) 618 (throw 'finished 619 (list 'syntax-error "mismatched block labels" (point) pos)))) 620 621 (t 622 ;; we don't have a begin label. In this case, the begin 623 ;; statement might not start a block if it is the begining of a 624 ;; procedure or declare block over which we need to skip. 625 626 (cond ((memq previous-block-kind '(toplevel declare-statement)) 627 (goto-char (cdr previous-block))) 628 ((and (listp previous-block-kind) 629 (memq (nth 0 previous-block-kind) 630 '(defun-start package package-body))) 631 (unless (sqlind-labels-match 632 label (nth 1 previous-block-kind)) 633 (throw 'finished 634 (list 'syntax-error 635 "bad end label for defun" (point) pos))) 636 (goto-char (cdr previous-block))))))))))) 637 638 (defun sqlind-maybe-declare-statement () 639 "If (point) is on a DECLARE statement, report its syntax. 640 Only keywords in program code are matched, not the ones inside 641 expressions, also we don't match DECLARE directives here. 642 643 See also `sqlind-beginning-of-block'" 644 (when (looking-at "declare") 645 646 ;; In Postgres, a DECLARE statement can be a block, or define a cursor 647 ;; (see pr67.sql, pr92.sql for examples). It is somewhat tricky to 648 ;; determine which is which, so we use the heuristic that a declare 649 ;; statement immediately following a $$ is a block, otherwise it is not. 650 (when (or (not (eq sql-product 'postgres)) 651 (save-excursion 652 (sqlind-backward-syntactic-ws) 653 (skip-syntax-backward "_w") ; note that the $$ is symbol constituent! 654 (looking-at "\\(\\$\\$\\)\\|begin\\|then\\|else\\|\\(<<[a-z0-9_]+>>\\)"))) 655 (throw 'finished 656 (if (null sqlind-end-stmt-stack) 657 'declare-statement 658 (list 'syntax-error "nested declare block" (point) (point))))))) 659 660 (defun sqlind-maybe-skip-create-options () 661 "Move point past any MySQL option declarations. 662 663 Statements like \"CREATE VIEW\" or \"CREATE TABLE\" can have 664 various options betwen the CREATE keyword and the thing being 665 created. If such options exist at (point) the cursor is moved 666 past them. 667 668 Currently we move over the following options, for different 669 products: 670 671 MySQL: 672 673 TEMPORARY 674 ALGORITHM = {UNDEFINED | MERGE | TEMPTABLE} 675 DEFINER = { user | CURENT_USER } 676 SQL SECURITY { DEFINER | INVOKER } 677 678 PostgresSQL 679 680 TEMP 681 TEMPORARY 682 GLOBAL 683 LOCAL 684 UNLOGGED 685 MATERIALIZED 686 687 Oracle 688 689 PRIVATE 690 TEMP 691 TEMPORARY 692 MATERIALIZED 693 694 We don't consider if the options are valid or not for the thing 695 being created. We just skip any and all of them that are 696 present." 697 (cond 698 ((eq sql-product 'mysql) 699 (catch 'finished 700 (while t 701 (cond 702 ((looking-at "temporary\\_>") 703 (goto-char (match-end 0)) 704 (sqlind-forward-syntactic-ws)) 705 ((looking-at "\\(definer\\|algorithm\\)\\(\\s-\\|[\n]\\)*=\\(\\s-\\|[\n]\\)*\\S-+") 706 (goto-char (match-end 0)) 707 (sqlind-forward-syntactic-ws)) 708 ((looking-at "sql\\(\\s-\\|[\n]\\)+security\\(\\s-\\|[\n]\\)+\\S-+") 709 (goto-char (match-end 0)) 710 (sqlind-forward-syntactic-ws)) 711 (t (throw 'finished nil)))))) 712 ((eq sql-product 'postgres) 713 (catch 'finished 714 (while t 715 (cond 716 ((looking-at "temp\\(orary\\)?\\_>") 717 (goto-char (match-end 0)) 718 (sqlind-forward-syntactic-ws)) 719 ((looking-at "\\(global\\|local\\|unlogged\\)\\_>") 720 (goto-char (match-end 0)) 721 (sqlind-forward-syntactic-ws)) 722 ((looking-at "materialized\\_>") 723 (goto-char (match-end 0)) 724 (sqlind-forward-syntactic-ws)) 725 (t (throw 'finished nil)))))) 726 ((eq sql-product 'oracle) 727 (catch 'finished 728 (while t 729 (cond 730 ((looking-at "temp\\(orary\\)\\_>") 731 (goto-char (match-end 0)) 732 (sqlind-forward-syntactic-ws)) 733 ((looking-at "materialized\\_>") 734 (goto-char (match-end 0)) 735 (sqlind-forward-syntactic-ws)) 736 ((looking-at "private\\_>") 737 (goto-char (match-end 0)) 738 (sqlind-forward-syntactic-ws)) 739 (t (throw 'finished nil)))))))) 740 741 (defun sqlind-maybe-create-statement (&optional all-statements) 742 "If (point) is on a CREATE statement, report its syntax. 743 See also `sqlind-beginning-of-block' 744 745 Normally, only block start create statements are considered (such 746 as creation of procedures). In particular, create 747 table/view/index statements are ignored unless the ALL-STATEMENTS 748 argument is t" 749 (when (or (looking-at "create\\_>\\(?:[ \t\n\r\f]+\\)\\(or\\(?:[ \t\n\r\f]+\\)replace\\_>\\)?") 750 (looking-at "alter\\_>")) 751 (prog1 t ; make sure we return t 752 (save-excursion 753 ;; let's see what are we creating 754 (goto-char (match-end 0)) 755 (sqlind-forward-syntactic-ws) 756 (sqlind-maybe-skip-create-options) 757 (let ((what (intern (downcase (buffer-substring-no-properties 758 (point) 759 (progn (forward-word) (point)))))) 760 (name (downcase (buffer-substring-no-properties 761 (progn (sqlind-forward-syntactic-ws) 762 ;; Skip over a possible "if (not) 763 ;; exists", to get the actual name 764 (when (looking-at "if\\(\\s-\\|[\n]\\)+\\(not\\)?\\(\\s-\\|[\n]\\)exists") 765 (goto-char (match-end 0)) 766 (sqlind-forward-syntactic-ws)) 767 (point)) 768 (progn (skip-syntax-forward "w_()") (point)))))) 769 (when (and (eq what 'package) (equal name "body")) 770 (setq what 'package-body) 771 (setq name (downcase 772 (buffer-substring-no-properties 773 (progn (sqlind-forward-syntactic-ws) (point)) 774 (progn (skip-syntax-forward "w_()") (point)))))) 775 776 ;; Keep just the name, not the argument list 777 (when (string-match "\\(.*?\\)(" name) 778 (setq name (match-string 1 name))) 779 780 (cond 781 ((memq what '(procedure function package package-body)) 782 ;; check is name is in the form user.name, if so then suppress user part. 783 (when (string-match "\\(?:.*\\.\\)?\\(.*\\)" name) 784 (setq name (match-string 1 name))) 785 (if (null sqlind-end-stmt-stack) 786 (throw 'finished 787 (list (if (memq what '(procedure function)) 'defun-start what) 788 name)) 789 (cl-destructuring-bind (pos kind label) (pop sqlind-end-stmt-stack) 790 (when (not (eq kind nil)) 791 (throw 'finished 792 (list 'syntax-error 793 "bad closing for create block" (point) pos))) 794 (unless (sqlind-labels-match label name) 795 (throw 'finished 796 (list 'syntax-error 797 "label mismatch in create block" (point) pos)))))) 798 ((memq what '(table view index)) 799 ;; Table, view and index creations do not begin blocks and they 800 ;; are ignored unless the ALL-STATEMENTS parameter is t 801 (when all-statements 802 (throw 'finished (list 'create-statement what name)))) 803 (t 804 (unless (null sqlind-end-stmt-stack) 805 (throw 'finished 806 (list 'syntax-error "nested create statement" (point) (point)))) 807 (throw 'finished (list 'create-statement what name))))))))) 808 809 (defun sqlind-maybe-defun-statement () 810 "If (point) is on a procedure definition statement, report its syntax. 811 See also `sqlind-beginning-of-block'" 812 (catch 'exit 813 (when (looking-at "\\(procedure\\|function\\)\\(?:[ \t\n\r\f]+\\)\\(?:[a-z0-9_]+\\.\\)?\\([a-z0-9_]+\\)") 814 (prog1 t ; make sure we return t 815 (let ((proc-name (sqlind-match-string 2))) 816 ;; need to find out if this is a procedure/function 817 ;; declaration or a definition 818 (save-excursion 819 (goto-char (match-end 0)) 820 (sqlind-forward-syntactic-ws) 821 ;; skip param list, if any. 822 (when (looking-at "(") 823 (ignore-errors (forward-sexp 1)) 824 (sqlind-forward-syntactic-ws)) 825 (when (looking-at "return\\(?:[ \t\n\r\f]+\\)\\([a-z0-9_.]+\\(?:%\\(?:row\\)?type\\)?\\)") 826 (goto-char (match-end 0)) 827 (sqlind-forward-syntactic-ws)) 828 (when (looking-at ";") 829 ;; not a procedure after all. 830 (throw 'exit nil))) 831 832 (save-excursion 833 (sqlind-backward-syntactic-ws) 834 ;; Find out if it is a drop procedure or function statement 835 (forward-word -1) 836 (when (looking-at "drop") 837 ;; not a procedure after all 838 (throw 'exit nil)) 839 ;; Find out if it is a "comment on" statement (postgres only) 840 (when (and (eq sql-product 'postgres) 841 (looking-at "on")) 842 (sqlind-backward-syntactic-ws) 843 (forward-word -1) 844 (when (looking-at "comment") 845 ;; not a procedure after all. 846 (throw 'exit nil)))) 847 848 ;; so it is a definition 849 850 ;; if the procedure starts with "create or replace", move 851 ;; point to the real start 852 (let ((real-start (point))) 853 (save-excursion 854 (forward-word -1) 855 (when (looking-at "replace") 856 (forward-word -2)) 857 (when (and (or (looking-at "create\\([ \t\r\n\f]+or[ \t\r\n\f]+replace\\)?") 858 (looking-at "alter")) 859 (not (sqlind-in-comment-or-string (point)))) 860 (setq real-start (point)))) 861 (goto-char real-start)) 862 863 (when (null sqlind-end-stmt-stack) 864 (throw 'finished (list 'defun-start proc-name))) 865 866 (cl-destructuring-bind (pos kind label) (pop sqlind-end-stmt-stack) 867 (unless (and (eq kind nil) 868 (sqlind-labels-match label proc-name)) 869 (throw 'finished 870 (list 'syntax-error "bad end label for defun" (point) pos))))))))) 871 872 (defun sqlind-maybe-exception-statement () 873 "If (point) is on an exception keyword, report its syntax. 874 See also `sqlind-beginning-of-block'" 875 (when (and (looking-at "exception") 876 (null sqlind-end-stmt-stack)) 877 ;; Exception is both a keyword and a type. We need to only stop on the 878 ;; keyword. We detect that if the previous token is either ";" or 879 ;; "BEGIN". 880 (save-excursion 881 (forward-char -1) 882 (sqlind-backward-syntactic-ws) 883 (when (or (looking-at ";") 884 (progn (forward-word -1) (looking-at "\\<_begin\\_>"))) 885 (throw 'finished (list 'in-block 'exception)))))) 886 887 (defun sqlind-maybe-$$-statement () 888 "If (point) is on a PostgreSQL $$ quote, report its syntax. 889 890 PostgreSQL uses $$ to delimit SQL blocks in create statements, 891 this function tries to determine if the $$ block is a begin or an 892 end block and creates the appropiate syntactic context. 893 894 See also `sqlind-beginning-of-block'" 895 (when (looking-at "\\$\\$") 896 (prog1 t 897 (let* ((saved-pos (point))) 898 (ignore-errors (forward-char -1)) 899 (sqlind-backward-syntactic-ws) 900 (cond ((looking-at ";") 901 ;; Assume the $$ is ending a statement (previous line is a ';' 902 ;; which ends another statement) 903 (push (list saved-pos '$$ "") sqlind-end-stmt-stack) 904 (goto-char saved-pos)) 905 ((progn (forward-word -1) 906 (looking-at "end")) 907 ;; Assume the $$ is ending a statement (previous line contains 908 ;; an "end" keyword) 909 (push (list saved-pos '$$ "") sqlind-end-stmt-stack) 910 (goto-char saved-pos)) 911 ((null sqlind-end-stmt-stack) 912 (sqlind-beginning-of-statement) 913 (let ((syntax (catch 'finished 914 (sqlind-maybe-create-statement) 915 (sqlind-maybe-defun-statement) 916 'toplevel))) 917 (if (and (listp syntax) (eq (nth 0 syntax) 'defun-start)) 918 (throw 'finished (list 'in-begin-block 'defun (nth 1 syntax))) 919 (throw 'finished (list 'in-begin-block syntax nil))))) 920 (t 921 (sqlind-beginning-of-statement) 922 (cl-destructuring-bind (pos kind _label) (pop sqlind-end-stmt-stack) 923 (unless (eq kind '$$) 924 (throw 'finished 925 (list 'syntax-error "bad closing for $$ begin block" (point) pos)))))))))) 926 927 (defconst sqlind-start-block-regexp 928 (concat "\\(\\_<" 929 (regexp-opt '("if" "then" "else" "elsif" "elseif" "loop" 930 "begin" "declare" "create" "alter" "exception" 931 "procedure" "function" "end" "case") t) 932 "\\_>\\)\\|)\\|\\$\\$") 933 "Regexp to match the start of a block.") 934 935 (defun sqlind-beginning-of-block (&optional end-statement-stack) 936 "Find the start of the current block and return its syntax. 937 938 END-STATEMENT-STACK contains a list of \"end\" syntaxes in 939 reverse order (a stack) and is used to skip over nested blocks." 940 (interactive) 941 ;; This function works as follows: `sqlind-start-block-regexp` defines the 942 ;; keywords where it stops to inspect the code. Each time it stops at one 943 ;; of these keywords, it checks to see if the keyword is inside a comment or 944 ;; string. If the keyworkd is not inside a comment or string, the 945 ;; `sqlind-maybe-*` functions are called to check if the keyword is valid. 946 ;; Each of these functions will do one of the following: 947 ;; 948 ;; * throw a syntax object with a 'finished tag, if they decide that the 949 ;; keyword is valid 950 ;; 951 ;; * return t to indicate that they decided that the keyword is not valid 952 ;; and `sqlind-beginning-of-block` should search for the next keyword 953 ;; 954 ;; * return nil to indicate that they don't recognize the keyword and 955 ;; another `sqlind-maybe-*` function should be called 956 ;; 957 ;; Some of these `sqlind-maybe-*` functions are specific to the 958 ;; `sql-product` and are only invoked for the speficied SQL dialect. 959 960 (catch 'finished 961 (let ((sqlind-end-stmt-stack end-statement-stack)) 962 (while (re-search-backward sqlind-start-block-regexp sqlind-search-limit 'noerror) 963 (or (sqlind-in-comment-or-string (point)) 964 (when (looking-at ")") (forward-char 1) (forward-sexp -1) t) 965 (sqlind-maybe-end-statement) 966 (sqlind-maybe-if-statement) 967 (sqlind-maybe-case-statement) 968 (sqlind-maybe-then-statement) 969 (sqlind-maybe-exception-statement) 970 (sqlind-maybe-else-statement) 971 (sqlind-maybe-loop-statement) 972 (sqlind-maybe-begin-statement) 973 (when (memq sql-product '(oracle postgres)) 974 ;; declare statements only start blocks in PL/SQL and PostgresSQL 975 (sqlind-maybe-declare-statement)) 976 (when (eq sql-product 'postgres) 977 (sqlind-maybe-$$-statement)) 978 (sqlind-maybe-create-statement) 979 (sqlind-maybe-defun-statement)))) 980 'toplevel)) 981 982 ;;;;; Determine the syntax inside a case expression 983 984 (defconst sqlind-case-clauses-regexp 985 "\\_<\\(when\\|then\\|else\\|end\\)\\_>") 986 987 (defun sqlind-syntax-in-case (pos start) 988 "Return the syntax at POS which is part a \"case\" expression at START." 989 (save-excursion 990 (goto-char pos) 991 (cond ((looking-at "when\\|else") 992 ;; A WHEN, or ELSE clause is indented relative to the start of the 993 ;; case expression 994 (cons 'case-clause start)) 995 ((looking-at "end") 996 (cons (list 'block-end 'case "") start)) 997 ((looking-at "then") 998 ;; THEN and ELSE clauses are indented relative to the start of the 999 ;; when clause, which we must find 1000 (while (not (and (re-search-backward "\\_<when\\_>") 1001 (sqlind-same-level-statement (point) start))) 1002 nil) 1003 (cons 'case-clause-item (point))) 1004 (t 1005 ;; It is a statement continuation from the closest CASE element 1006 (while (and (not (= (point) start)) 1007 (not (and (re-search-backward sqlind-case-clauses-regexp start 'noerror) 1008 (sqlind-same-level-statement (point) start)))) 1009 nil) 1010 (cons 'case-clause-item-cont (point)))))) 1011 1012 ;;;;; Determine the syntax inside a with statement 1013 1014 (defconst sqlind-with-clauses-regexp 1015 "\\_<\\(with\\|recursive\\)\\_>") 1016 1017 (defun sqlind-syntax-in-with (pos start) 1018 "Return the syntax at POS which is part of a \"with\" statement at START." 1019 (save-excursion 1020 (catch 'finished 1021 (goto-char pos) 1022 (cond 1023 ((looking-at sqlind-with-clauses-regexp) 1024 (throw 'finished (cons 'with-clause start))) 1025 ((and (looking-at "\\_<select\\_>") 1026 (sqlind-same-level-statement (point) start)) 1027 (throw 'finished (cons 'with-clause start)))) 1028 (while (re-search-backward "\\_<select\\_>" start 'noerror) 1029 (when (sqlind-same-level-statement (point) start) 1030 (throw 'finished (sqlind-syntax-in-select pos (point))))) 1031 (goto-char pos) 1032 (when (looking-at "\\_<as\\_>") 1033 (throw 'finished (cons 'with-clause-cte-cont start))) 1034 (sqlind-backward-syntactic-ws) 1035 (when (looking-at ",") 1036 (throw 'finished (cons 'with-clause-cte start))) 1037 (forward-word -1) 1038 (when (looking-at sqlind-with-clauses-regexp) 1039 ;; We're right after the with (recursive keyword) 1040 (throw 'finished (cons 'with-clause-cte start))) 1041 (throw 'finished (cons 'with-clause-cte-cont start))))) 1042 1043 ;;;;; Determine the syntax inside a select statement 1044 1045 (defconst sqlind-select-clauses-regexp 1046 (concat 1047 "\\_<\\(" 1048 "\\(\\(union\\(\\s-+all\\)?\\)\\|intersect\\|minus\\|except\\)?[ \t\r\n\f]*select\\|" 1049 "\\(bulk[ \t\r\n\f]+collect[ \t\r\n\f]+\\)?into\\|" 1050 "perform\\|" 1051 "from\\|" 1052 "where\\|" 1053 "order[ \t\r\n\f]+by\\|" 1054 "having\\|" 1055 "group[ \t\r\n\f]+by\\|" 1056 "connect[ \t\r\n\f]+by\\|" 1057 "start[ \t\r\n\f]+with\\|" 1058 "limit" 1059 "\\)\\_>")) 1060 1061 (defconst sqlind-select-join-regexp 1062 (regexp-opt '("inner" "left" "right" "natural" "cross" "full") 'symbols)) 1063 1064 (defconst sqlind-join-condition-regexp 1065 (regexp-opt '("on" "using" "and" "or") 'symbols)) 1066 1067 (defun sqlind-find-join-start (start limit) 1068 "Look backwards for the start of a JOIN statement, 1069 begin looking for it at the START position in the buffer, and 1070 look backwards until LIMIT is reached. Returns the buffer 1071 position where the JOIN condition starts, or nil if no JOIN 1072 statement is found." 1073 (save-excursion 1074 (when (sqlind-search-backward start "\\bjoin\\b" limit) 1075 (let ((candidate (point))) 1076 (forward-char -1) 1077 (sqlind-backward-syntactic-ws) 1078 (backward-word) 1079 (if (looking-at sqlind-select-join-regexp) 1080 (point) 1081 ;; The "outer" keyword is composed with a "left" or "right" keyword 1082 ;; so we need to move backwards one more word. 1083 (if (looking-at "\\bouter\\b") 1084 (progn 1085 (forward-char -1) 1086 (sqlind-backward-syntactic-ws) 1087 (backward-word) 1088 (if (looking-at "\\b\\(left\\|right\\)\\b") 1089 (point) 1090 candidate)) 1091 candidate)))))) 1092 1093 (defun sqlind-syntax-in-select (pos start) 1094 "Return the syntax ar POS which is inside a \"select\" statement at START." 1095 (save-excursion 1096 (catch 'finished 1097 (goto-char pos) 1098 1099 ;; all select query components are indented relative to the 1100 ;; start of the select statement) 1101 (when (looking-at sqlind-select-clauses-regexp) 1102 (throw 'finished (cons 'select-clause start))) 1103 1104 ;; when we are not looking at a select component, find the 1105 ;; nearest one from us. 1106 1107 (while (sqlind-search-backward (point) sqlind-select-clauses-regexp start) 1108 (let* ((match-pos (match-beginning 0)) 1109 (clause (sqlind-match-string 0))) 1110 (setq clause (replace-regexp-in-string "[ \t\r\n\f]" " " clause)) 1111 (when (sqlind-same-level-statement (point) start) 1112 (cond 1113 ((or (looking-at "select\\(\\s *\\_<\\(top\\s +[0-9]+\\|distinct\\|unique\\)\\_>\\)?") 1114 (and (eq sql-product 'postgres) (looking-at "perform\\_>"))) 1115 ;; we are in the column selection section. 1116 (goto-char pos) 1117 (if (looking-at ",") 1118 (throw 'finished (cons 'select-column match-pos)) 1119 (progn 1120 (sqlind-backward-syntactic-ws) 1121 (throw 'finished 1122 (cons (if (or (eq (match-end 0) (1+ (point))) 1123 (looking-at ",")) 1124 'select-column 1125 'select-column-continuation) 1126 match-pos))))) 1127 1128 ((looking-at "from") 1129 ;; FROM is only keyword if the previous char is NOT a 1130 ;; comma ',' 1131 (forward-char -1) 1132 (sqlind-backward-syntactic-ws) 1133 (unless (looking-at ",") 1134 ;; We are in the from section. If this line starts with 'on' 1135 ;; or the previous line ends with 'on' we have a join 1136 ;; condition 1137 (goto-char pos) 1138 (when (or (looking-at sqlind-join-condition-regexp) 1139 (progn (forward-word -1) 1140 (and (sqlind-same-level-statement (point) pos) 1141 (looking-at sqlind-select-join-regexp)))) 1142 ;; look for the join start, that will be the anchor 1143 (let ((jstart (sqlind-find-join-start (point) start))) 1144 (when jstart 1145 (throw 'finished (cons 'select-join-condition jstart)))))) 1146 1147 ;; if this line starts with a ',' or the previous line starts 1148 ;; with a ',', we have a new table 1149 (goto-char pos) 1150 ;; NOTE: the combination of tests and movement operations in 1151 ;; the when clause is not ideal... 1152 (when (or (looking-at ",") 1153 (looking-at sqlind-select-join-regexp) 1154 (looking-at "join\\b") 1155 (progn 1156 (sqlind-backward-syntactic-ws) 1157 (or (looking-at ",") 1158 (progn 1159 (forward-word -1) 1160 (or (looking-at sqlind-select-join-regexp) 1161 (looking-at "join\\b") 1162 (looking-at "from\\b")))))) 1163 (throw 'finished (cons 'select-table match-pos))) 1164 1165 (goto-char pos) 1166 (let ((limit match-pos)) 1167 (if (sqlind-search-backward (point) (regexp-opt (list "," "join") 'symbols) limit) 1168 (progn 1169 (goto-char (match-end 0)) 1170 (sqlind-forward-syntactic-ws) 1171 (when (looking-at "lateral") 1172 (forward-word 1) 1173 (sqlind-forward-syntactic-ws)) 1174 ;; otherwise, we continue the table definition from the 1175 ;; previous line. 1176 (throw 'finished 1177 ;; If, after following all these joins, we got back 1178 ;; to our line, we are in a select-table after all, 1179 ;; otherwise it is a table continuation. 1180 (if (eq (point) pos) 1181 (cons 'select-table match-pos) 1182 (cons 'select-table-continuation (point))))) 1183 (progn ; this must be the first table in the FROM section 1184 (when (looking-at "from\\b") 1185 (forward-word) 1186 (sqlind-forward-syntactic-ws)) 1187 (throw 'finished (cons 'select-table-continuation (point))))))) 1188 1189 (t 1190 (throw 'finished 1191 (cons (list 'in-select-clause clause) match-pos)))))))))) 1192 1193 1194 ;;;;; Determine the syntax inside an insert statement 1195 1196 (defconst sqlind-insert-clauses-regexp 1197 "\\_<\\(insert\\([ \t\r\n\f]+into\\)?\\|values\\|select\\)\\_>") 1198 1199 (defun sqlind-syntax-in-insert (pos start) 1200 "Return the syntax at POS which is inside an \"insert\" statement at START." 1201 1202 ;; The insert clause is really easy since it has the form insert into TABLE 1203 ;; (COLUMN_LIST) values (VALUE_LIST) or insert into TABLE select 1204 ;; SELECT_CLAUSE 1205 ;; 1206 ;; note that we will never be called when point is in COLUMN_LIST or 1207 ;; VALUE_LIST, as that is a nested-statement-continuation which starts with 1208 ;; the open paranthesis. 1209 ;; 1210 ;; if we are inside the SELECT_CLAUSE, we delegate the syntax to 1211 ;; `sqlind-syntax-in-select' 1212 1213 (save-excursion 1214 (catch 'finished 1215 (goto-char pos) 1216 1217 ;; all select query components are indented relative to the 1218 ;; start of the select statement) 1219 (when (looking-at sqlind-insert-clauses-regexp) 1220 (throw 'finished (cons 'insert-clause start))) 1221 1222 (while (re-search-backward sqlind-insert-clauses-regexp start t) 1223 (let* ((match-pos (match-beginning 0)) 1224 (clause (sqlind-match-string 0))) 1225 (setq clause (replace-regexp-in-string "[ \t\r\n\f]" " " clause)) 1226 (when (sqlind-same-level-statement (point) start) 1227 (throw 'finished 1228 (if (looking-at "select") 1229 (sqlind-syntax-in-select pos match-pos) 1230 (cons (list 'in-insert-clause clause) match-pos))))))))) 1231 1232 1233 ;;;;; Determine the syntax inside a delete statement 1234 1235 (defconst sqlind-delete-clauses-regexp 1236 "\\_<\\(delete\\([ \t\r\n\f]+from\\)?\\|where\\|returning\\|\\(bulk[ \t\r\n\f]collect[ \t\r\n\f]\\)?into\\)\\_>") 1237 1238 (defun sqlind-syntax-in-delete (pos start) 1239 "Return the syntax at POS which is inside a \"delete\" statement at START." 1240 (save-excursion 1241 (catch 'finished 1242 (goto-char pos) 1243 1244 ;; all select query components are indented relative to the 1245 ;; start of the select statement) 1246 (when (looking-at sqlind-delete-clauses-regexp) 1247 (throw 'finished (cons 'delete-clause start))) 1248 1249 (while (re-search-backward sqlind-delete-clauses-regexp start t) 1250 (let* ((match-pos (match-beginning 0)) 1251 (clause (sqlind-match-string 0))) 1252 (setq clause (replace-regexp-in-string "[ \t\r\n\f]" " " clause)) 1253 (when (sqlind-same-level-statement (point) start) 1254 (throw 'finished 1255 (cons (list 'in-delete-clause clause) match-pos)))))))) 1256 1257 1258 ;;;;; Determine the syntax inside an update statement 1259 1260 (defconst sqlind-update-clauses-regexp 1261 "\\_<\\(update\\|set\\|where\\)\\_>") 1262 1263 (defun sqlind-syntax-in-update (pos start) 1264 "Return the syntax at POS which is inside an \"update\" statement at START." 1265 (save-excursion 1266 (catch 'finished 1267 (goto-char pos) 1268 1269 ;; all select query components are indented relative to the start of the 1270 ;; select statement) 1271 (when (looking-at sqlind-update-clauses-regexp) 1272 (throw 'finished (cons 'update-clause start))) 1273 1274 (while (re-search-backward sqlind-update-clauses-regexp start t) 1275 (let* ((match-pos (match-beginning 0)) 1276 (clause (sqlind-match-string 0))) 1277 (setq clause (replace-regexp-in-string "[ \t\r\n\f]" " " clause)) 1278 (when (sqlind-same-level-statement (point) start) 1279 (throw 'finished 1280 (cons (list 'in-update-clause clause) match-pos)))))))) 1281 1282 1283 ;;;;; Refine the syntax of an end statement. 1284 1285 (defun sqlind-refine-end-syntax (end-kind end-label end-pos context) 1286 "Return a \\='block-end syntax when line contains an \"end\" keyword. 1287 1288 END-KIND contains the symbol after the end statement (\\='if if 1289 the statement is an \"end if\", \\='loop if the statement is an 1290 \"end loop\", etc). This can be nil if there is a plain \"end\" 1291 keyword. 1292 1293 END-LABEL contains the label of the end statement, when there is 1294 one. 1295 1296 END-POS is the position where the \"end\" keyword is. 1297 1298 CONTEXT represents the syntactic context up to the current line. 1299 1300 The function will perform some validations, for example, an \"end 1301 if\" must close an if statement, an \"end loop\" must close a 1302 loop, etc. It will return a \\='syntax-error syntax if the 1303 validation fails. 1304 1305 If all checks pass, it will return a (block-end KIND LABEL) where 1306 KIND is the symbol determining the type of the block (\\='if, 1307 \\='loop, \\='procedure, etc) and LABEL is the block label, if 1308 there is any." 1309 (catch 'done 1310 1311 (when (null context) ; can happen 1312 (throw 'done 1313 (cons (list 'syntax-error "end statement closes nothing" 1314 end-pos end-pos) 1315 end-pos))) 1316 1317 (let ((syntax (sqlind-syntax context)) 1318 (anchor (sqlind-anchor-point context)) 1319 (syntax-symbol (sqlind-syntax-symbol context))) 1320 (cond 1321 ((memq syntax-symbol '(package package-body)) 1322 ;; we are closing a package declaration or body, `end-kind' must be 1323 ;; empty, `end-label' can be empty or it must match the package name 1324 (throw 'done 1325 (cons 1326 (cond (end-kind ; no end-kind is allowed for a package 1327 (list 'syntax-error 1328 "bad closing for package" anchor end-pos)) 1329 ((sqlind-labels-match end-label (nth 1 syntax)) 1330 (list 'block-end syntax-symbol (nth 1 syntax))) 1331 (t 1332 (list 'syntax-error "mismatched end label for package" 1333 anchor end-pos))) 1334 anchor))) 1335 1336 ((eq syntax-symbol 'in-begin-block) 1337 ;; we are closing a begin block (either toplevel, procedure/function 1338 ;; or a simple begin block. `end-kind' must be empty, `end-label' 1339 ;; can be empty or it must match the pakage-name 1340 (let ((block-label (nth 2 syntax))) 1341 (throw 'done 1342 (cons 1343 (cond (end-kind ; no end-kind is allowed for a begin block 1344 (list 'syntax-error 1345 "bad closing for begin block" anchor end-pos)) 1346 ((sqlind-labels-match end-label block-label) 1347 (list 'block-end (nth 1 syntax) block-label)) 1348 (t 1349 (list 'syntax-error "mismatched end label for block" 1350 anchor end-pos))) 1351 anchor)))) 1352 1353 ((eq syntax-symbol 'in-block) 1354 (let ((block-kind (nth 1 syntax)) 1355 (block-label (nth 2 syntax))) 1356 (cond 1357 ((eq block-kind 'exception) 1358 (goto-char anchor) 1359 (throw 'done 1360 (sqlind-refine-end-syntax 1361 end-kind end-label end-pos (sqlind-syntax-of-line)))) 1362 1363 ((eq block-kind 'loop) 1364 (throw 'done 1365 (cons 1366 (cond ((not (eq end-kind 'loop)) 1367 (list 'syntax-error "bad closing for loop block" 1368 anchor end-pos)) 1369 ((not (sqlind-labels-match end-label block-label)) 1370 (list 'syntax-error "mismatched end label for loop" 1371 anchor end-pos)) 1372 (t 1373 (list 'block-end block-kind block-label))) 1374 anchor))) 1375 1376 ((eq block-kind 'then) 1377 (goto-char anchor) 1378 1379 (catch 'found 1380 (while t 1381 (let ((then-context (sqlind-syntax-of-line))) 1382 (goto-char (cdar then-context)) 1383 (cond 1384 ((looking-at "when\\_>\\|then\\_>") t) 1385 ((looking-at "\\(?:<<\\([a-z0-9_]+\\)>>[ \t\r\n\f]*\\)?\\_<\\(if\\|case\\)\\_>") 1386 (throw 'found t)) 1387 (t 1388 (throw 'done 1389 (cons 1390 (list 'syntax-error "bad syntax start for then keyword" 1391 (point) (point)) 1392 anchor))))))) 1393 1394 (let ((start-label (or (sqlind-match-string 1) "")) 1395 (start-kind (intern (sqlind-match-string 2)))) 1396 (throw 'done 1397 (cons 1398 (cond ((not (or (null end-kind) (eq end-kind start-kind))) 1399 (list 'syntax-error "bad closing for if/case block" 1400 (point) end-pos)) 1401 ((not (sqlind-labels-match end-label start-label)) 1402 (list 'syntax-error "mismatched labels for if/case block" 1403 (point) end-pos)) 1404 (t 1405 (list 'block-end start-kind start-label))) 1406 anchor)))) 1407 1408 ((memq block-kind '(else elsif elseif)) 1409 ;; search the enclosing then context and refine form there. The 1410 ;; `cdr' in sqlind-syntax-of-line is used to remove the 1411 ;; block-start context for the else clause 1412 (goto-char anchor) 1413 (throw 'done 1414 (sqlind-refine-end-syntax 1415 end-kind end-label end-pos (cdr (sqlind-syntax-of-line))))) 1416 1417 ((memq block-kind '(if case)) 1418 (throw 'done 1419 (cons 1420 (cond ((not (eq end-kind block-kind)) 1421 (list 'syntax-error "bad closing for if/case block" 1422 anchor end-pos)) 1423 ((not (sqlind-labels-match end-label block-label)) 1424 (list 'syntax-error 1425 "bad closing for if/case block (label mismatch)" 1426 anchor end-pos)) 1427 (t (list 'block-end block-kind block-label))) 1428 anchor))) 1429 ))) 1430 1431 ((memq syntax-symbol '(block-start comment-start)) 1432 ;; there is a more generic context following one of these 1433 (throw 'done 1434 (sqlind-refine-end-syntax 1435 end-kind end-label end-pos (cdr context)))) 1436 1437 ((eq syntax-symbol 'defun-start) 1438 (throw 'done 1439 (cons 1440 (if (and (null end-kind) 1441 (sqlind-labels-match end-label (nth 1 syntax))) 1442 (list 'block-end 'defun end-label) 1443 (list 'syntax-error "mismatched end label for defun" 1444 anchor end-pos)) 1445 anchor))) 1446 1447 ((eq syntax-symbol 'block-end) 1448 (goto-char anchor) 1449 (forward-line -1) 1450 (throw 'done 1451 (sqlind-refine-end-syntax 1452 end-kind end-label end-pos (sqlind-syntax-of-line))))) 1453 1454 ;; if the above cond fell through, we have a syntax error 1455 (cons (list 'syntax-error "end statement closes nothing" 1456 end-pos end-pos) 1457 anchor)))) 1458 1459 1460 ;;;;; sqlind-syntax-of-line 1461 1462 (defun sqlind-refine-syntax (context pos have-block-context) 1463 "Refine a basic syntax CONTEXT at POS. 1464 CONTEXT is a syntactic context obtained by looking at the 1465 statement start and block start, see `sqlind-syntax-of-line'. We 1466 refine it by looking at the contents of the current line and the 1467 contents of the anchor. 1468 1469 HAVE-BLOCK-CONTEXT indicates that we are indenting a statement, 1470 not a statement-continuation POS is the same as the 1471 `sqlind-beginning-of-statement'." 1472 (let ((syntax (sqlind-syntax context)) 1473 (anchor (sqlind-anchor-point context)) 1474 (syntax-symbol (sqlind-syntax-symbol context))) 1475 1476 (goto-char pos) 1477 1478 (cond 1479 ;; do we start a comment? 1480 ((and (not (eq syntax-symbol 'comment-continuation)) 1481 (looking-at sqlind-comment-start-skip)) 1482 (push (cons 'comment-start anchor) context)) 1483 1484 ;; Refine a statement continuation 1485 ((memq syntax-symbol '(statement-continuation nested-statement-continuation)) 1486 1487 ;; a (nested) statement continuation which starts with loop 1488 ;; or then is a block start 1489 (if (and have-block-context (looking-at "\\(loop\\|then\\|when\\)\\_>")) 1490 (push (cons (list 'block-start (intern (sqlind-match-string 0))) anchor) 1491 context) 1492 ;; else 1493 (goto-char anchor) 1494 (when (eq syntax 'nested-statement-continuation) 1495 (forward-char 1) 1496 (sqlind-forward-syntactic-ws) 1497 (setq anchor (point))) 1498 1499 ;; when all we have before `pos' is a label, we have a 1500 ;; labeled-statement-start 1501 (when (looking-at "<<\\([a-z0-9_]+\\)>>") 1502 (goto-char (match-end 0)) 1503 (forward-char 1) 1504 (sqlind-forward-syntactic-ws) 1505 (when (eq (point) pos) 1506 (push (cons 'labeled-statement-start anchor) context))) 1507 1508 (when (looking-at "when\\_>") 1509 (let* ((acontext (sqlind-syntax-of-line)) 1510 (asyntax (sqlind-syntax acontext))) 1511 (cond ((equal asyntax '(in-block exception "")) 1512 (push (cons '(in-block exception-handler "") (point)) context)) 1513 ((equal asyntax '(block-start when)) 1514 ;; Refine again in the context of the when line 1515 (setq context (sqlind-refine-syntax (cdr acontext) pos have-block-context)))))) 1516 1517 ;; maybe we have a DML statement (select, insert, update and 1518 ;; delete) 1519 1520 ;; skip a cursor definition if it is before our point, in the 1521 ;; following format: 1522 ;; 1523 ;; CURSOR name IS 1524 ;; CURSOR name type IS 1525 (when (looking-at "cursor\\b") 1526 (let ((origin (point))) 1527 (forward-sexp 1) ; skip "cursor" 1528 (sqlind-forward-syntactic-ws) 1529 (forward-sexp 1) 1530 (sqlind-forward-syntactic-ws) 1531 (if (looking-at "is\\b") 1532 (progn 1533 (goto-char (match-end 0)) 1534 (sqlind-forward-syntactic-ws)) 1535 (forward-sexp 1) 1536 (sqlind-forward-syntactic-ws) 1537 (when (looking-at "is\\b") 1538 (goto-char (match-end 0)) 1539 (sqlind-forward-syntactic-ws))) 1540 (unless (<= (point) pos) 1541 (goto-char origin)))) 1542 1543 ;; Skip a PostgreSQL cursor declaration 1544 (when (and (eq sql-product 'postgres) 1545 (looking-at "\\(\\(declare\\)\\|\\(cursor\\)\\|\\(for\\)\\)\\b")) 1546 (when (re-search-forward "\\b\\(select\\|update\\|delete\\|insert\\)\\b" pos 'noerror) 1547 (goto-char (match-beginning 0)))) 1548 1549 ;; skip a forall statement if it is before our point 1550 (when (looking-at "forall\\b") 1551 (when (re-search-forward "\\b\\(select\\|update\\|delete\\|insert\\)\\b" pos 'noerror) 1552 (goto-char (match-beginning 0)))) 1553 1554 ;; only check for syntax inside DML clauses if we are not 1555 ;; at the start of one. 1556 (when (< (point) pos) 1557 (cond 1558 ;; NOTE: We only catch here "CASE" expressions, not CASE 1559 ;; statements. We also catch assignments with case (var 1560 ;; := CASE ...) 1561 ((looking-at "\\(\\w+[ \t\r\n\f]+:=[ \t\r\n\f]+\\)?\\(case\\)") 1562 (when (< (match-beginning 2) pos) 1563 (push (sqlind-syntax-in-case pos (match-beginning 2)) context))) 1564 ((looking-at "with") 1565 (push (sqlind-syntax-in-with pos (point)) context)) 1566 ((looking-at "select") 1567 (push (sqlind-syntax-in-select pos (point)) context)) 1568 ((and (eq sql-product 'postgres) 1569 (looking-at "perform")) 1570 (push (sqlind-syntax-in-select pos (point)) context)) 1571 ((looking-at "insert") 1572 (push (sqlind-syntax-in-insert pos (point)) context)) 1573 ((looking-at "delete") 1574 (push (sqlind-syntax-in-delete pos (point)) context)) 1575 ((looking-at "update") 1576 (push (sqlind-syntax-in-update pos (point)) context)))) 1577 1578 (when (eq (sqlind-syntax-symbol context) 'select-column-continuation) 1579 (let ((cdef (sqlind-column-definition-start pos (sqlind-anchor-point context)))) 1580 (when cdef 1581 (save-excursion 1582 (goto-char cdef) 1583 (when (looking-at "case") 1584 (push (sqlind-syntax-in-case pos (point)) context)))))) 1585 1586 (when (eq (sqlind-syntax-symbol context) 'nested-statement-continuation) 1587 (save-excursion 1588 ;; Look for a join expression inside a nested statement, see #70 1589 (goto-char pos) 1590 (when (or (looking-at sqlind-join-condition-regexp) 1591 (progn (forward-word -1) (looking-at sqlind-join-condition-regexp))) 1592 ;; look for the join start, that will be the anchor 1593 (let ((jstart (sqlind-find-join-start (point) anchor))) 1594 (when jstart 1595 (push (cons 'select-join-condition jstart) context)))))) 1596 1597 )) 1598 1599 ;; create block start syntax if needed 1600 1601 ((and (eq syntax-symbol 'in-block) 1602 (memq (nth 1 syntax) '(if elsif elseif then case)) 1603 (looking-at "\\(then\\|\\(els\\(e\\|e?if\\)\\)\\)\\_>")) 1604 (let ((what (intern (sqlind-match-string 0)))) 1605 ;; the only invalid combination is a then statement in 1606 ;; an (in-block "then") context 1607 (unless (and (eq what 'then) (equal (nth 1 syntax) 'then)) 1608 (push (cons (list 'block-start what) anchor) context)))) 1609 1610 ((and (eq syntax-symbol 'in-block) 1611 (eq (nth 1 syntax) 'exception) 1612 (not (looking-at "\\(when\\|end\\)\\_>"))) 1613 (save-excursion 1614 (when (sqlind-search-backward pos "when\\_>" anchor) 1615 (push (cons (list 'in-block 'exception-handler) (point)) context)))) 1616 1617 ;; note that begin is not a block-start in a 'in-begin-block 1618 ;; context 1619 ((and (memq syntax-symbol '(defun-start declare-statement toplevel 1620 package package-body)) 1621 (or (looking-at "begin\\_>") 1622 (and (eq sql-product 'postgres) (looking-at "\\$\\$")))) 1623 (push (cons (list 'block-start 'begin) anchor) context)) 1624 1625 ((and (memq syntax-symbol '(defun-start package package-body)) 1626 (looking-at "\\(is\\|as\\)\\_>")) 1627 (push (cons (list 'block-start 'is-or-as) anchor) context)) 1628 1629 ((and (memq syntax-symbol '(in-begin-block in-block)) 1630 (looking-at "exception\\_>")) 1631 (push (cons (list 'block-start 'exception) anchor) context)) 1632 1633 ((and (eq syntax-symbol 'in-block) 1634 (memq (nth 1 syntax) '(then case)) 1635 (not (looking-at "end\\s-*\\_<\\(if\\|case\\)\\_>"))) 1636 (if (looking-at "when\\_>") 1637 (push (cons (list 'block-start 'when) anchor) context) 1638 ;; NOTE: the "when" case is handed above 1639 (when (sqlind-search-backward pos "when\\_>" anchor) 1640 (push (cons '(in-block when) (point)) context)))) 1641 1642 ;; indenting the select clause inside a view or a "create table as" 1643 ;; statement. 1644 ((and (eq syntax-symbol 'create-statement) 1645 (memq (nth 1 syntax) '(view table))) 1646 (goto-char anchor) 1647 (catch 'done 1648 (while (re-search-forward "\\bselect\\b" pos 'noerror) 1649 (goto-char (match-beginning 0)) 1650 (when (sqlind-same-level-statement (point) anchor) 1651 (push (sqlind-syntax-in-select pos (point)) context) 1652 (throw 'done nil)) 1653 (goto-char (match-end 0))))) 1654 1655 ;; create a block-end syntax if needed 1656 1657 ((and (not (eq syntax-symbol 'comment-continuation)) 1658 (looking-at "end[ \t\r\n\f]*\\(\\_<\\(?:if\\|loop\\|case\\)\\_>\\)?[ \t\r\n\f]*\\(\\_<\\(?:[a-z0-9_]+\\)\\_>\\)?")) 1659 ;; so we see the syntax which closes the current block. We still 1660 ;; need to check if the current end is a valid closing block 1661 (let ((kind (or (sqlind-match-string 1) "")) 1662 (label (or (sqlind-match-string 2) ""))) 1663 (push (sqlind-refine-end-syntax 1664 (if (equal kind "") nil (intern kind)) 1665 label (point) context) 1666 context))) 1667 1668 ((and (eq sql-product 'postgres) 1669 (not (eq syntax-symbol 'comment-continuation)) 1670 (looking-at "\\$\\$")) 1671 (push (sqlind-refine-end-syntax 1672 nil "" (point) context) 1673 context)) 1674 1675 ;; See #92 and pr92b.sql, no such thing as a nested declare statement, use 1676 ;; the context of the previous declare-statement! 1677 ((and (eq sql-product 'postgres) 1678 (eq syntax-symbol 'declare-statement) 1679 (looking-at "declare\\_>")) 1680 (goto-char anchor) 1681 (setq context (sqlind-syntax-of-line))) 1682 1683 ) 1684 context)) 1685 1686 (defun sqlind-syntax-of-line () 1687 "Return the syntax at the start of the current line. 1688 The function returns a list of (SYNTAX . ANCHOR) cons cells. 1689 SYNTAX is either a symbol or a list starting with a symbol, 1690 ANCHOR is a buffer position which is the reference for the 1691 SYNTAX. `sqlind-indentation-syntax-symbols' lists the syntax 1692 symbols and their meaning. 1693 1694 The first element in the list is the most specific syntax for the 1695 line, the remaining elemens are more generic ones. For example, 1696 a line can be inside an SELECT clause which itself is inside a 1697 procedure block." 1698 (save-excursion 1699 (with-syntax-table sqlind-syntax-table 1700 (let* ((pos (progn (back-to-indentation) (point))) 1701 (sqlind-search-limit (sqlind-beginning-of-directive)) 1702 (context-start (progn (sqlind-beginning-of-statement) (point))) 1703 (context (list (cons 'statement-continuation context-start))) 1704 (have-block-context nil)) 1705 1706 (goto-char context-start) 1707 (when (or (>= context-start pos) 1708 (and (looking-at sqlind-start-block-regexp) 1709 ;; create table/view/index statements are not block 1710 ;; contexts 1711 (or (not (looking-at "\\(create\\)\\|\\(alter\\)")) 1712 (catch 'finished (sqlind-maybe-create-statement) nil)) 1713 ;; A declare statement may or may not be a block context 1714 (or (not (looking-at "declare")) 1715 (catch 'finished (sqlind-maybe-declare-statement) nil)) 1716 (not (sqlind-looking-at-begin-transaction)))) 1717 (goto-char pos) 1718 ;; if we are at the start of a statement, or the nearest statement 1719 ;; starts after us, make the enclosing block the starting context 1720 (setq have-block-context t) 1721 (let ((block-info (sqlind-beginning-of-block))) 1722 1723 ;; certain kind of blocks end within a statement 1724 ;; (e.g. create view). If we found one of those blocks and 1725 ;; it is not within our statement, we ignore the block info. 1726 1727 (if (and (listp block-info) 1728 (eq (nth 0 block-info) 'create-statement) 1729 (not (memq (nth 1 block-info) '(function procedure))) 1730 (not (eql context-start (point)))) 1731 (progn 1732 (setq context-start (point-min)) 1733 (setq context (list (cons 'toplevel context-start)))) 1734 ;; else 1735 (setq context-start (point)) 1736 (setq context (list (cons block-info context-start)))))) 1737 1738 (goto-char context-start) 1739 (when (and (eq 'statement-continuation (sqlind-syntax-symbol context)) 1740 (looking-at "\\(create\\)\\|\\(alter\\)")) 1741 (let ((create-info (catch 'finished (sqlind-maybe-create-statement t) nil))) 1742 (when create-info 1743 (pop context) ; remove the statement continuation syntax 1744 (push (cons create-info context-start) context)))) 1745 1746 (let ((parse-info (syntax-ppss pos))) 1747 (cond ((nth 4 parse-info) ; inside a comment 1748 (push (cons 'comment-continuation (nth 8 parse-info)) context)) 1749 ((nth 3 parse-info) ; inside a string 1750 (push (cons 'string-continuation (nth 8 parse-info)) context)) 1751 ((> (nth 0 parse-info) 0) ; nesting 1752 (let ((start (nth 1 parse-info))) 1753 (goto-char (1+ start)) 1754 (skip-chars-forward " \t\r\n\f\v" pos) 1755 (if (eq (point) pos) 1756 (push (cons 'nested-statement-open start) context) 1757 (goto-char pos) 1758 (if (looking-at ")") 1759 (push (cons 'nested-statement-close start) context) 1760 (push (cons 'nested-statement-continuation start) context))))))) 1761 1762 ;; now let's refine the syntax by adding info about the current line 1763 ;; into the mix. 1764 (sqlind-refine-syntax context pos have-block-context))))) 1765 1766 1767 (defun sqlind-show-syntax-of-line () 1768 "Print the syntax of the current line." 1769 (interactive) 1770 (prin1 (sqlind-syntax-of-line))) 1771 1772 1773 ;;;; Indentation of SQL code 1774 ;;;;; Indentation calculation routines 1775 (defvar sqlind-basic-offset 2 1776 "The basic indentaion amount for SQL code. 1777 Indentation is usually done in multiples of this amount, but 1778 special indentation functions can do other types of indentation 1779 such as aligning. See also `sqlind-indentation-offsets-alist'.") 1780 1781 (make-variable-buffer-local 'sqlind-basic-offset) 1782 1783 (defvar sqlind-indentation-syntax-symbols '() 1784 "This variable exists just for its documentation. 1785 1786 The the SQL parsing code returns a syntax definition (either a 1787 symbol or a list) and an anchor point, which is a buffer 1788 position. The syntax symbols can be used to define how to indent 1789 each line, see `sqlind-indentation-offsets-alist' 1790 1791 The following syntax symbols are defined for SQL code: 1792 1793 - (syntax-error MESSAGE START END) -- this is returned when the 1794 parse failed. MESSAGE is an informative message, START and END 1795 are buffer locations denoting the problematic region. ANCHOR 1796 is undefined for this syntax info 1797 1798 - `in-comment' -- line is inside a multi line comment, ANCHOR is 1799 the start of the comment. 1800 1801 - `comment-start' -- line starts with a comment. ANCHOR is the 1802 start of the enclosing block. 1803 1804 - `in-string' -- line is inside a string, ANCHOR denotes the start 1805 of the string. 1806 1807 - `toplevel' -- line is at toplevel (not inside any programming 1808 construct). ANCHOR is usually (point-min). 1809 1810 - (in-block BLOCK-KIND LABEL) -- line is inside a block 1811 construct. BLOCK-KIND (a symbol) is the actual block type and 1812 can be one of \"if\", \"case\", \"exception\", \"loop\" etc. 1813 If the block is labeled, LABEL contains the label. ANCHOR is 1814 the start of the block. 1815 1816 - (in-begin-block KIND LABEL) -- line is inside a block started 1817 by a begin statement. KIND (a symbol) is \"toplevel-block\" 1818 for a begin at toplevel, \"defun\" for a begin that starts the 1819 body of a procedure or function, \"package\" for a begin that 1820 starts the body of a package, or nil for a begin that is none 1821 of the previous. For a \"defun\" or \"package\", LABEL is the 1822 name of the procedure, function or package, for the other block 1823 types LABEL contains the block label, or the empty string if 1824 the block has no label. ANCHOR is the start of the block. 1825 1826 - (block-start KIND) -- line begins with a statement that starts 1827 a block. KIND (a symbol) can be one of \"then\", \"else\" or 1828 \"loop\". ANCHOR is the reference point for the block 1829 start (the coresponding if, case, etc). 1830 1831 - (block-end KIND LABEL) -- the line contains an end statement. 1832 KIND (a symbol) is the type of block we are closing, LABEL (a 1833 string) is the block label (or procedure name for an end 1834 defun). 1835 1836 - declare-statement -- line is after a declare keyword, but 1837 before the begin. ANCHOR is the start of the declare 1838 statement. 1839 1840 - (package NAME) -- line is inside a package definition. NAME is 1841 the name of the package, ANCHOR is the start of the package. 1842 1843 - (package-body NAME) -- line is inside a package body. NAME is 1844 the name of the package, ANCHOR is the start of the package 1845 body. 1846 1847 - (create-statement WHAT NAME) -- line is inside a CREATE 1848 statement (other than create procedure or function). WHAT is 1849 the thing being created, NAME is its name. ANCHOR is the start 1850 of the create statement. 1851 1852 - (defun-start NAME) -- line is inside a procedure of function 1853 definition but before the begin block that starts the body. 1854 NAME is the name of the procedure/function, ANCHOR is the start 1855 of the procedure/function definition. 1856 1857 The following SYNTAX-es are for SQL statements. For all of 1858 them ANCHOR points to the start of a statement itself. 1859 1860 - labeled-statement-start -- line is just after a label. 1861 1862 - statement-continuation -- line is inside a statement which 1863 starts on a previous line. 1864 1865 - nested-statement-open -- line is just inside an opening 1866 bracket, but the actual bracket is on a previous line. 1867 1868 - nested-statement-continuation -- line is inside an opening 1869 bracket, but not the first element after the bracket. 1870 1871 - nested-statement-close -- line is inside an opening bracket and 1872 the line contains the closing bracket as the first character. 1873 1874 The following SYNTAX-es are for statements which are SQL 1875 code (DML statements). They are pecialisations on the previous 1876 statement syntaxes and for all of them a previous generic 1877 statement syntax is present earlier in the SYNTAX list. Unless 1878 otherwise specified, ANCHOR points to the start of the 1879 clause (select, from, where, etc) in which the current point is. 1880 1881 - with-clause -- line is inside a WITH clause, but before the 1882 main SELECT clause. 1883 1884 - with-clause-cte -- line is inside a with clause before a 1885 CTE (common table expression) declaration 1886 1887 - with-clause-cte-cont -- line is inside a with clause before a 1888 CTE definition 1889 1890 - case-clause -- line is on a CASE expression (WHEN or END 1891 clauses). ANCHOR is the start of the CASE expression. 1892 1893 - case-clause-item -- line is on a CASE expression (THEN and ELSE 1894 clauses). ANCHOR is the position of the case clause. 1895 1896 - case-clause-item-cont -- line is on a CASE expression but not 1897 on one of the CASE sub-keywords. ANCHOR points to the case 1898 keyword that this line is a continuation of. 1899 1900 - select-clause -- line is inside a select statement, right 1901 before one of its clauses (from, where, order by, etc). 1902 1903 - select-column -- line is inside the select column section, 1904 after a full column was defined (and a new column definition is 1905 about to start). 1906 1907 - select-column-continuation -- line is inside the select column 1908 section, but in the middle of a column definition. The defined 1909 column starts on a previous like. Note that ANCHOR still 1910 points to the start of the select statement itself. 1911 1912 - select-join-condition -- line is right before or just after the ON clause 1913 for an INNER, LEFT or RIGHT join. ANCHOR points to the join statement 1914 for which the ON is defined. 1915 1916 - select-table -- line is inside the from clause, just after a 1917 table was defined and a new one is about to start. 1918 1919 - select-table-continuation -- line is inside the from clause, 1920 inside a table definition which starts on a previous line. Note 1921 that ANCHOR still points to the start of the select statement 1922 itself. 1923 1924 - (in-select-clause CLAUSE) -- line is inside the select CLAUSE, 1925 which can be \"where\", \"order by\", \"group by\" or 1926 \"having\". Note that CLAUSE can never be \"select\" and 1927 \"from\", because we have special syntaxes inside those 1928 clauses. 1929 1930 - insert-clause -- line is inside an insert statement, right 1931 before one of its clauses (values, select). 1932 1933 - (in-insert-clause CLAUSE) -- line is inside the insert CLAUSE, 1934 which can be \"insert into\" or \"values\". 1935 1936 - delete-clause -- line is inside a delete statement right before 1937 one of its clauses. 1938 1939 - (in-delete-clause CLAUSE) -- line is inside a delete CLAUSE, 1940 which can be \"delete from\" or \"where\". 1941 1942 - update-clause -- line is inside an update statement right 1943 before one of its clauses. 1944 1945 - (in-update-clause CLAUSE) -- line is inside an update CLAUSE, 1946 which can be \"update\", \"set\" or \"where\".") 1947 1948 (defconst sqlind-default-indentation-offsets-alist 1949 '((syntax-error sqlind-report-sytax-error) 1950 (in-string sqlind-report-runaway-string) 1951 1952 (comment-continuation sqlind-indent-comment-continuation) 1953 (comment-start sqlind-indent-comment-start) 1954 1955 (toplevel 0) 1956 (in-block +) 1957 (in-begin-block +) 1958 (block-start 0) 1959 (block-end 0) 1960 (declare-statement +) 1961 (package ++) 1962 (package-body 0) 1963 (create-statement +) 1964 (defun-start +) 1965 (labeled-statement-start 0) 1966 (statement-continuation +) 1967 (nested-statement-open sqlind-use-anchor-indentation +) 1968 (nested-statement-continuation sqlind-use-previous-line-indentation) 1969 (nested-statement-close sqlind-use-anchor-indentation) 1970 1971 (with-clause sqlind-use-anchor-indentation) 1972 (with-clause-cte +) 1973 (with-clause-cte-cont ++) 1974 (case-clause 0) 1975 (case-clause-item sqlind-use-anchor-indentation +) 1976 (case-clause-item-cont sqlind-right-justify-clause) 1977 (select-clause sqlind-right-justify-clause) 1978 (select-column sqlind-indent-select-column) 1979 (select-column-continuation sqlind-indent-select-column +) 1980 (select-join-condition ++) 1981 (select-table sqlind-indent-select-table) 1982 (select-table-continuation sqlind-indent-select-table +) 1983 (in-select-clause sqlind-lineup-to-clause-end 1984 sqlind-right-justify-logical-operator) 1985 (insert-clause sqlind-right-justify-clause) 1986 (in-insert-clause sqlind-lineup-to-clause-end 1987 sqlind-right-justify-logical-operator) 1988 (delete-clause sqlind-right-justify-clause) 1989 (in-delete-clause sqlind-lineup-to-clause-end 1990 sqlind-right-justify-logical-operator) 1991 (update-clause sqlind-right-justify-clause) 1992 (in-update-clause sqlind-lineup-to-clause-end 1993 sqlind-right-justify-logical-operator)) 1994 "Define the indentation amount for each syntactic symbol. 1995 1996 The value of this variable is an ALIST with the format: 1997 1998 ((SYNTACTIC-SYMBOL . INDENTATION-OFFSETS) ... ) 1999 2000 `sqlind-indentation-syntax-symbols' documents the list of possible 2001 SYNTACTIC-SYMBOL values. 2002 2003 INDENTATION-OFFSETS defines the adjustments made to the 2004 indentation for each syntactic-symbol. It is a list of: 2005 2006 a NUMBER -- the NUMBER will be added to the indentation offset. 2007 2008 '+ -- the current indentation offset is incremented by 2009 `sqlind-basic-offset' 2010 2011 '++ -- the current indentation offset is indentation by 2 * 2012 `sqlind-basic-offset' 2013 2014 '- -- the current indentation offset is decremented by 2015 `sqlind-basic-offset' 2016 2017 '-- -- the current indentation offset is decremented by 2 * 2018 `sqlind-basic-offset' 2019 2020 a FUNCTION -- the syntax and current indentation offset is 2021 passed to the function and its result is used as the new 2022 indentation offset. 2023 2024 See `sqlind-calculate-indentation' for how the indentation offset 2025 is calculated.") 2026 2027 (defvar sqlind-indentation-offsets-alist 2028 sqlind-default-indentation-offsets-alist 2029 "Define the indentation amount for each syntactic symbol. 2030 See also `sqlind-default-indentation-offsets-alist', 2031 `sqlind-indentation-syntax-symbols' and 2032 `sqlind-calculate-indentation'") 2033 2034 (make-variable-buffer-local 'sqlind-indentation-offsets-alist) 2035 2036 (defun sqlind-calculate-indentation (syntax &optional base-indentation) 2037 "Return the indentation that should be applied to the current line. 2038 SYNTAX is the syntaxtic information as returned by 2039 `sqlind-syntax-of-line', BASE-INDENTATION is an indentation offset 2040 to start with. When BASE-INDENTATION is nil, it is initialised 2041 to the column of the anchor. 2042 2043 The indentation is done as follows: first, the indentation 2044 offsets for the current syntactic symbol is looked up in 2045 `sqlind-indentation-offsets-alist'. Than, for each indentation 2046 offset, BASE-INDENTATION is adjusted according to that 2047 indentation offset. The final value of BASE-INDENTATION is than 2048 returned." 2049 (if (null syntax) 2050 base-indentation 2051 ;; else 2052 2053 ;; when the user did not specify a base-indentation, we use the 2054 ;; column of the anchor as a starting point 2055 (when (null base-indentation) 2056 (setq base-indentation (save-excursion 2057 (goto-char (cdar syntax)) 2058 (current-column)))) 2059 2060 (let* ((syntax-symbol (sqlind-syntax-symbol syntax)) 2061 (indent-info (cdr (assoc syntax-symbol 2062 sqlind-indentation-offsets-alist))) 2063 (new-indentation base-indentation)) 2064 2065 ;; the funcall below can create a nil indentation symbol to 2066 ;; abort the indentation process 2067 (while (and new-indentation indent-info) 2068 (let ((i (car indent-info))) 2069 (setq new-indentation 2070 (cond 2071 ((eq i '+) (+ new-indentation sqlind-basic-offset)) 2072 ((eq i '++) (+ new-indentation (* 2 sqlind-basic-offset))) 2073 ((eq i '-) (- new-indentation sqlind-basic-offset)) 2074 ((eq i '--) (- new-indentation (* 2 sqlind-basic-offset))) 2075 ((integerp i) (+ new-indentation i)) 2076 ((functionp i) (funcall i syntax new-indentation)) 2077 ;; ignore unknown symbols by default 2078 (t new-indentation)))) 2079 (setq indent-info (cdr indent-info))) 2080 new-indentation))) 2081 2082 ;;;;; Indentation helper functions 2083 2084 (defun sqlind-report-sytax-error (syntax _base-indentation) 2085 "Report a syntax error for a \\='syntax-error SYNTAX." 2086 (cl-destructuring-bind (_sym msg start end) (sqlind-syntax syntax) 2087 (message "%s (%d %d)" msg start end)) 2088 nil) 2089 2090 (defun sqlind-report-runaway-string (_syntax _base-indentation) 2091 "Report an error for a runaway string. 2092 This is a string that extends over multiple lines. This is not 2093 supported in SQL." 2094 (message "runaway string constant") 2095 nil) 2096 2097 (defun sqlind-use-anchor-indentation (syntax _base-indentation) 2098 "Return the indentation of the line containing anchor of SYNTAX. 2099 By default, the column of the anchor position is uses as a base 2100 indentation. You can use this function to switch to using the 2101 indentation of the anchor as the base indentation." 2102 (save-excursion 2103 (goto-char (sqlind-anchor-point syntax)) 2104 (current-indentation))) 2105 2106 (defun sqlind-lineup-to-anchor (syntax _base-indentation) 2107 "Return the column of the anchor point of SYNTAX. 2108 This need not be the indentation of the actual line that contains 2109 anchor." 2110 (save-excursion 2111 (goto-char (sqlind-anchor-point syntax)) 2112 (current-column))) 2113 2114 (defun sqlind-use-previous-line-indentation (syntax _base-indentation) 2115 "Return the indentation of the previous non-empty line. 2116 If the start of the previous line is before the anchor of SYNTAX, 2117 use the column of the anchor + 1." 2118 (let ((anchor (sqlind-anchor-point syntax))) 2119 (save-excursion 2120 (forward-line -1) 2121 (beginning-of-line) 2122 (while (and (looking-at "^\\s-*$") (> (point) anchor)) ; empty line, skip it 2123 (forward-line -1) 2124 (beginning-of-line)) 2125 (back-to-indentation) 2126 (if (< (point) anchor) 2127 (progn 2128 (goto-char anchor) 2129 (1+ (current-column))) 2130 (current-column))))) 2131 2132 (defun sqlind-indent-comment-continuation (syntax _base-indentation) 2133 "Return the indentation for a line inside a comment SYNTAX. 2134 If the current line matches `sqlind-comment-prefix' or 2135 `sqlind-comment-end', we indent to one plus the column of the 2136 comment start, which will make comments line up nicely, like 2137 this: 2138 2139 /* Some comment line 2140 * another comment line 2141 */ 2142 2143 When the current line does not match `sqlind-comment-prefix', we 2144 indent it so it lines up with the text of the start of the 2145 comment, like this: 2146 2147 /* Some comment line 2148 Some other comment line 2149 */" 2150 (save-excursion 2151 (back-to-indentation) 2152 (if (or (looking-at sqlind-comment-prefix) 2153 (looking-at sqlind-comment-end)) 2154 (progn 2155 (goto-char (sqlind-anchor-point syntax)) 2156 (1+ (current-column))) 2157 ;; else 2158 (goto-char (sqlind-anchor-point syntax)) 2159 (when (looking-at sqlind-comment-start-skip) 2160 (goto-char (match-end 0))) 2161 (current-column)))) 2162 2163 (defun sqlind-indent-comment-start (syntax base-indentation) 2164 "Return the indentation for a comment start SYNTAX. 2165 If we start a line comment (--) and the previous line also has a 2166 line comment, we line up the two comments. Otherwise we indent 2167 in the previous context (cdr SYNTAX) starting at 2168 BASE-INDENTATION." 2169 (save-excursion 2170 (back-to-indentation) 2171 (if (and (looking-at "\\s *--") 2172 (progn 2173 (forward-line -1) 2174 (re-search-forward "--" (line-end-position) t))) 2175 (progn 2176 (goto-char (match-beginning 0)) 2177 (current-column)) 2178 (sqlind-calculate-indentation 2179 (sqlind-outer-context syntax) base-indentation)))) 2180 2181 (defun sqlind-indent-select-column (syntax base-indentation) 2182 "Return the indentation for a column of a SELECT clause. 2183 2184 SYNTAX is the syntax of the current line, BASE-INDENTATION is the 2185 current indentation, which we need to update. 2186 2187 We try to align to the previous column start, but if we are the 2188 first column after the SELECT clause we simply add 2189 `sqlind-basic-offset'." 2190 (save-excursion 2191 (goto-char (sqlind-anchor-point syntax)) 2192 (when (or (looking-at "select\\s *\\(top\\s +[0-9]+\\|distinct\\|unique\\)?") 2193 (and (eq sql-product 'postgres) (looking-at "perform\\_>"))) 2194 (goto-char (match-end 0))) 2195 (skip-syntax-forward " ") 2196 (if (or (looking-at sqlind-comment-start-skip) 2197 (eolp)) 2198 (+ base-indentation sqlind-basic-offset) 2199 (current-column)))) 2200 2201 (defun sqlind-indent-select-table (syntax base-indentation) 2202 "Return the indentation for a table in the FROM section. 2203 2204 SYNTAX is the syntax of the current line, BASE-INDENTATION is the 2205 current indentation, which we need to update. 2206 2207 We try to align to the first table, but if we are the first 2208 table, we simply add `sqlind-basic-offset'." 2209 (save-excursion 2210 (goto-char (sqlind-anchor-point syntax)) 2211 (when (looking-at "from") 2212 (goto-char (match-end 0))) 2213 (skip-syntax-forward " ") 2214 (if (or (looking-at sqlind-comment-start-skip) 2215 (eolp)) 2216 (+ base-indentation sqlind-basic-offset) 2217 (current-column)))) 2218 2219 (defun sqlind-lineup-to-clause-end (syntax base-indentation) 2220 "Line up the current line with the end of a query clause. 2221 2222 This assumes SYNTAX is one of in-select-clause, in-update-clause, 2223 in-insert-clause or in-delete-clause. It will return an 2224 indentation so that: 2225 2226 If the clause is on a line by itself, the current line is 2227 indented by `sqlind-basic-offset', otherwise the current line is 2228 indented so that it starts in next column from where the clause 2229 keyword ends. 2230 Argument BASE-INDENTATION is updated." 2231 (cl-destructuring-bind ((_sym clause) . anchor) (car syntax) 2232 (save-excursion 2233 (goto-char anchor) 2234 (forward-char (1+ (length clause))) 2235 (skip-syntax-forward " ") 2236 (if (or (looking-at sqlind-comment-start-skip) 2237 (eolp)) 2238 ;; if the clause is on a line by itself, indent this line with a 2239 ;; sqlind-basic-offset 2240 (+ base-indentation sqlind-basic-offset) 2241 ;; otherwise, align to the end of the clause, with a few exceptions 2242 (current-column))))) 2243 2244 (defun sqlind-right-justify-logical-operator (syntax base-indentation) 2245 "Align an AND, OR or NOT operator with the end of the WHERE clause. 2246 2247 SYNTAX is the syntax of the current line, BASE-INDENTATION is the 2248 current indentation, which we need to update. 2249 2250 If this rule is added to the \\='in-select-clause syntax after 2251 the `sqlind-lineup-to-clause-end' rule, it will adjust lines 2252 starting with AND, OR or NOT to be aligned so they sit under the 2253 WHERE clause." 2254 (save-excursion 2255 (back-to-indentation) 2256 (cl-destructuring-bind ((_sym clause) . anchor) (car syntax) 2257 (if (and (equal clause "where") 2258 (looking-at "and\\|or\\|not")) 2259 (progn 2260 (goto-char anchor) 2261 (+ (current-column) 2262 (- (length clause) (- (match-end 0) (match-beginning 0))))) 2263 base-indentation)))) 2264 2265 (defun sqlind-left-justify-logical-operator (syntax base-indentation) 2266 "Align an AND, OR or NOT operator with the start of the WHERE clause. 2267 2268 SYNTAX is the syntax of the current line, BASE-INDENTATION is the 2269 current indentation, which we need to update. 2270 2271 If this rule is added to the \\='in-select-clause syntax after 2272 the `sqlind-lineup-to-clause-end' rule, it will adjust lines 2273 starting with AND, OR or NOT to be aligned so they sit left under 2274 the WHERE clause." 2275 (save-excursion 2276 (back-to-indentation) 2277 (cl-destructuring-bind ((_sym clause) . anchor) (car syntax) 2278 (if (and (equal clause "where") 2279 (looking-at "and\\|or\\|not")) 2280 (progn (goto-char anchor) (current-column)) 2281 base-indentation)))) 2282 2283 (defconst sqlind-operator-regexp 2284 (concat (regexp-opt '("||" "*" "/" "%" "+" "-" "<<" ">>" "&" "|" 2285 "<" "<=" ">" ">=" "=" "==" "!=" "<>") 2286 t) 2287 "\\s-*") 2288 "Regexp to match a SQL expression operator.") 2289 2290 (defun sqlind-adjust-operator (syntax base-indentation) 2291 "Adjust the indentation for operators in select clauses. 2292 2293 If the line to be indented starts with an operator, the 2294 right-hand operand is lined up with the left hand operand on the 2295 previous line. Otherwise, BASE-INDENTATION is returned. For 2296 example: 2297 2298 select col1, col2 2299 || col3 as composed_column, 2300 col4 2301 || col5 as composed_column2 2302 from my_table 2303 where cond1 = 1 2304 and cond2 = 2; 2305 2306 This is an indentation adjuster and needs to be added to the 2307 `sqlind-indentation-offsets-alist`" 2308 (save-excursion 2309 (with-syntax-table sqlind-syntax-table 2310 (back-to-indentation) 2311 ;; If there are non-word constituents at the beginning if the line, 2312 ;; consider them an operator and line up the line to the first word of the 2313 ;; line, not the operator 2314 (cond ((looking-at sqlind-operator-regexp) 2315 (let ((ofs (length (match-string 0)))) 2316 (if (eq (sqlind-syntax-symbol syntax) 2317 'select-column-continuation) 2318 (goto-char (sqlind-column-definition-start 2319 (point) (sqlind-anchor-point syntax))) 2320 (forward-line -1) 2321 (end-of-line) 2322 (sqlind-backward-syntactic-ws) 2323 ;; Previous function leaves us on the first non-white-space 2324 ;; character. This might be a string terminator (') char, move 2325 ;; the cursor one to the left, so 'forward-sexp' works correctly. 2326 (ignore-errors (forward-char 1)) 2327 (forward-sexp -1)) 2328 (max 0 (- (current-column) ofs)))) 2329 ('t base-indentation))))) 2330 2331 (defun sqlind-lone-semicolon (syntax base-indentation) 2332 "Indent a lone semicolon with the statement start. For example: 2333 2334 If the current line contains a single semicolon ';', it will be 2335 indented at the same level as the anhcor of SYNTAX. Otherwise, 2336 BASE-INDENTATION is returned unchanged. For example: 2337 2338 select col 2339 from my_table 2340 ; 2341 2342 This is an indentation adjuster and needs to be added to the 2343 `sqlind-indentation-offsets-alist`" 2344 (save-excursion 2345 (back-to-indentation) 2346 (if (looking-at ";") 2347 (sqlind-use-anchor-indentation syntax base-indentation) 2348 base-indentation))) 2349 2350 (defun sqlind-right-justify-clause (syntax base-indentation) 2351 "Return an indentation which right-aligns the first word at 2352 anchor of SYNTAX with the first word in the curent line. 2353 2354 This is intended to be used as an indentation function for 2355 select-clause, update-clause, insert-clause and update-clause 2356 syntaxes" 2357 (save-excursion 2358 (let ((clause-length 0) 2359 (statement-keyword-length 0) 2360 offset) 2361 (back-to-indentation) 2362 (when (looking-at "\\sw+\\b") 2363 (setq clause-length (- (match-end 0) (match-beginning 0)))) 2364 (goto-char (cdar syntax)) ; move to ANCHOR 2365 (when (looking-at "\\sw+\\b") 2366 (setq statement-keyword-length (- (match-end 0) (match-beginning 0)))) 2367 (setq offset (- statement-keyword-length clause-length)) 2368 (if (> offset 0) 2369 (+ base-indentation offset) 2370 base-indentation)))) 2371 2372 (defun sqlind-lineup-joins-to-anchor (syntax base-indentation) 2373 "Align JOIN keywords with the anchor point of SYNTAX. 2374 If the line starts with an INNER,OUTER or CROSS JOIN keyword, 2375 return the column of the anchor point, otherwise return 2376 BASE-INDENTATION. 2377 2378 If this rule is added to `select-table-continuation' indentation, 2379 it will indent lines starting with JOIN keywords to line up with 2380 the FROM keyword." 2381 (save-excursion 2382 (back-to-indentation) 2383 ;; NOTE: we are a bit loose here as we only look for the first keyword 2384 ;; which might indicate a join regexp, e.g. we are happy to see "left" 2385 ;; even though, the correct statement is "left outer? join" 2386 (if (or (looking-at sqlind-select-join-regexp) 2387 (looking-at "\\bjoin\\b")) 2388 (sqlind-lineup-to-anchor syntax base-indentation) 2389 base-indentation))) 2390 2391 (defun sqlind-lineup-open-paren-to-anchor (syntax base-indentation) 2392 "Align an open paranthesis with the anchor point of SYNTAX. 2393 If the line starts with an open paren \\='(\\=', return the 2394 column of the anchor point. If line does not start with an open 2395 paren, the function returns BASE-INDENTATION, acting as a no-op." 2396 (save-excursion 2397 (back-to-indentation) 2398 (if (looking-at "(") 2399 (sqlind-lineup-to-anchor syntax base-indentation) 2400 base-indentation))) 2401 2402 (defun sqlind-adjust-comma (_syntax base-indentation) 2403 "Lineup lines starting with a comma ',' to the word start. 2404 Adjust BASE-INDENTATION so that the actual word is lined up. For 2405 example: 2406 2407 SELECT col1 2408 , col2 -- ignore the comma and align the actual word." 2409 (save-excursion 2410 (back-to-indentation) 2411 (let ((ofs (if (looking-at ",\\s-*") (length (match-string 0)) 0))) 2412 (max 0 (- base-indentation ofs))))) 2413 2414 (defun sqlind-lineup-into-nested-statement (syntax _base-indentation) 2415 "Align the line to the first word inside a nested statement. 2416 Return the column of the first non-whitespace char in a nested 2417 statement. For example: 2418 2419 ( a, 2420 b, -- b is always aligned with \\='a\\=' 2421 ) 2422 2423 This function only makes sense in a 2424 \\='nested-statement-continuation SYTNAX indentation rule." 2425 (save-excursion 2426 (goto-char (sqlind-anchor-point syntax)) 2427 (end-of-line) 2428 (let ((limit (point))) 2429 (goto-char (sqlind-anchor-point syntax)) 2430 (forward-char 1) 2431 (sqlind-forward-syntactic-ws) 2432 (if (< (point) limit) 2433 (current-column) 2434 (progn 2435 (goto-char (sqlind-anchor-point syntax)) 2436 (back-to-indentation) 2437 (+ (current-column) sqlind-basic-offset)))))) 2438 2439 ;;;;; sqlind-indent-line 2440 2441 (defun sqlind-indent-line () 2442 "Indent the current line according to SQL conventions. 2443 `sqlind-basic-offset' defined the number of spaces in the basic 2444 indentation unit and `sqlind-indentation-offsets-alist' is used to 2445 determine how to indent each type of syntactic element." 2446 (let* ((syntax (sqlind-syntax-of-line)) 2447 (base-column (current-column)) 2448 (indent-column (sqlind-calculate-indentation syntax))) 2449 (when indent-column 2450 (back-to-indentation) 2451 (let ((offset (- base-column (current-column)))) 2452 ;; avoid modifying the buffer when the indentation does not 2453 ;; have to change 2454 (unless (eq (current-column) indent-column) 2455 (indent-line-to indent-column)) 2456 (when (> offset 0) 2457 (forward-char offset)))))) 2458 2459 ;;;; Alignment rules 2460 2461 (defvar sqlind-align-rules 2462 `(;; Line up the two side of arrow => 2463 (sql-arrow-lineup 2464 (regexp . "\\(\\s-*\\)=>\\(\\s-*\\)") 2465 (modes quote (sql-mode)) 2466 (group 1 2) 2467 (case-fold . t) 2468 (repeat . t)) 2469 ;; Line up the two sides of an assigment 2470 (sql-assign-lineup 2471 (regexp . "^\\s-*\\S-+\\(\\s-*\\):=\\(\\s-*\\)") 2472 (modes quote (sql-mode)) 2473 (group 1 2) 2474 (case-fold . t) 2475 (repeat . t)) 2476 ;; lineup a variable declaration with an assignment 2477 (sql-assign-lineup-2 2478 (regexp . "^\\s-*\\S-+\\(\\s-+\\)\\S-+\\(\\s-*\\):=\\(\\s-*\\)") 2479 (modes quote (sql-mode)) 2480 (group 1 2 3) 2481 (case-fold . t) 2482 (repeat . t)) 2483 ;; Line up the two sides of in / out / in out parameter 2484 (sql-param-lineup-in-out 2485 (regexp . "\\(\\s-+\\)\\(in out\\|in\\|out\\)\\(\\s-+\\)") 2486 (modes quote (sql-mode)) 2487 (group 1 3) 2488 (case-fold . t) 2489 (repeat . t)) 2490 ;; Line up the two sides of an equal sign in an update expression 2491 (sql-equals 2492 (regexp . "[^:<>!]\\(\\s-*\\)=\\(\\s-*\\)[^>]") 2493 (modes quote (sql-mode)) 2494 (group 1 2) 2495 (case-fold . t) 2496 (valid . ,(function (lambda () 2497 (save-excursion 2498 (goto-char (match-end 1)) 2499 (not (nth 3 (syntax-ppss (point)))))))) 2500 (repeat . t)) 2501 (sql-comparison-operators ; see issue #47 2502 (regexp . "[^:]\\(\\s-*\\)[<>=!]+\\(\\s-*\\)[^>]") 2503 (modes quote (sql-mode)) 2504 (group 1 2) 2505 (case-fold . t) 2506 (valid . ,(function (lambda () 2507 (save-excursion 2508 (goto-char (match-end 1)) 2509 (not (nth 3 (syntax-ppss (point)))))))) 2510 (repeat . t)) 2511 ;; Line up the two sides of piped string 2512 (sql-pipes 2513 (regexp . "[^:]\\(\\s-*\\)||\\(\\s-*\\)[^>]") 2514 (modes quote (sql-mode)) 2515 (group 1 2) 2516 (case-fold . t) 2517 (repeat . t)) 2518 ;; lineup the column aliases (the "as name" part) in a select statement 2519 (sql-select-lineup-column-names 2520 (regexp . ".*?\\(\\s +\\)as\\(\\s +\\).*") 2521 (modes quote (sql-mode)) 2522 (group 1 2) 2523 (case-fold . t) 2524 (repeat . t))) 2525 "Align rules for SQL codes. 2526 2527 These rules help aligning some SQL statements, such as the column 2528 names in select queries, or equal signs in update statements or 2529 where clauses. 2530 2531 To use it, select the region to be aligned and run \\[align]. 2532 2533 See also `align' and `align-rules-list'") 2534 2535 ;;;; sqlind-minor-mode, sqlind-setup 2536 2537 (defvar sqlind-minor-mode-map 2538 (let ((map (make-sparse-keymap))) 2539 (define-key map [remap beginning-of-defun] 'sqlind-beginning-of-block) 2540 map)) 2541 2542 (defvar align-mode-rules-list) 2543 2544 ;;;###autoload 2545 (define-minor-mode sqlind-minor-mode 2546 "Toggle SQL syntactic indentation on or off. 2547 With syntactic indentation, hitting TAB on a line in a SQL buffer 2548 will indent the line according to the syntactic context of the 2549 SQL statement being edited. 2550 2551 A set of alignment rules are also enabled with this minor mode. 2552 Selecting a region of text and typing `M-x align RET' will align 2553 the statements. This can be used, for example, to align the `as' 2554 column aliases in select statements." 2555 :lighter " sqlind" 2556 ;; :group 'sqlind ;;FIXME: There's no such group! 2557 :global nil 2558 :init-value nil 2559 (if sqlind-minor-mode 2560 (progn 2561 (set (make-local-variable 'indent-line-function) #'sqlind-indent-line) 2562 (set (make-local-variable 'align-mode-rules-list) sqlind-align-rules)) 2563 (progn 2564 (kill-local-variable 'indent-line-function) 2565 (kill-local-variable 'align-mode-rules-list)))) 2566 2567 ;;;###autoload 2568 (defun sqlind-setup () 2569 "Enable SQL syntactic indentation unconditionally. 2570 This function is deprecated, consider using the function 2571 `sqlind-minor-mode' instead." 2572 (set (make-local-variable 'indent-line-function) 'sqlind-indent-line) 2573 (define-key sql-mode-map [remap beginning-of-defun] 'sqlind-beginning-of-statement) 2574 (setq align-mode-rules-list sqlind-align-rules)) 2575 2576 ;; Local Variables: 2577 ;; mode: emacs-lisp 2578 ;; mode: outline-minor 2579 ;; outline-regexp: ";;;;+" 2580 ;; End: 2581 2582 (provide 'sql-indent) 2583 ;;; sql-indent.el ends here