Download
(defgroup plsql nil "")
(defcustom plsql-indent 3
"*Number of columns of indentation for each level."
:group 'plsql
:type 'number)
(defcustom plsql-uses-font-lock t
"*Indicate whether font-lock properties can be use to speed up indentation.
This is up to 3 times faster, and hence, highly recommended."
:group 'plsql
:type 'boolean)
(defcustom plsql-mode-hook '()
"*Hook for customizing `plsql-mode'."
:type 'hook
:group 'plsql)
(defvar plsql-debug nil
"If t then we rebuild everything on reload. Useful for debugging.")
(eval-when-compile (setq plsql-debug t))
(defun plsql-toggle-debug () "Toggle value of plsql-debug."
(interactive)
(message "plsql-debug is %s" (setq plsql-debug (not plsql-debug))))
(defun plsql-reset (variable)
"t iff VARIABLE should be reset"
(or plsql-debug
(null variable)
(string-equal variable "")))
(defvar plsql-indent-function-stack nil
"Record the indent functions use to indent the current line.")
(defvar plsql-white-space-re "[ \t\n\r()]"
"Regular expression matching whitespace or anything that delimits
identifiers.")
(when (plsql-reset plsql-white-space-re)
(setq plsql-white-space-re "[ \t\n\r()]" ))
(defun plsql-in-comment-p (&optional limit)
"Return non-nil iff point is in a comment.
LIMIT is a point before the current point used to limit the partial parse."
(or (looking-at "/\\*")
(nth 4 (parse-partial-sexp limit (point)))))
(defun plsql-in-string-p (&optional limit)
"Return non-nil iff point is in a string.
LIMIT is a point before the current point used to limit the partial parse."
(nth 3 (parse-partial-sexp limit (point))))
(defun plsql-comment-face-p (&optional limit)
"Return non-nil iff text at point is displayed in a `font-lock-comment-face'."
(eq (get-text-property (point) 'face) 'font-lock-comment-face))
(defun plsql-string-face-p (&optional limit)
"Return non-nil iff text at point is displayed in a `font-lock-string-face'."
(eq (get-text-property (point) 'face) 'font-lock-string-face))
(defvar plsql-in-comment-predicate 'plsql-in-comment-p
"Function used to determine if point is inside a comment.")
(defvar plsql-in-string-predicate 'plsql-in-string-p
"Function used to determine if point is inside a string.")
(defsubst plsql-re-search-backward
(regexp &optional bound no-error count limit)
"Search backwards for REGEXP ignoring comments and strings.
Optional parameters BOUND, NO-ERROR and COUNT behave as for `re-search-backward'.
LIMIT is used to bound partial parse and is assumed to be before the current point."
(let ((not-found t)
(limit (or limit 1)))
(while (and not-found
(re-search-backward regexp bound no-error count))
(forward-char 1)
(unless (or (funcall plsql-in-comment-predicate limit)
(funcall plsql-in-string-predicate limit))
(setq not-found nil))
(forward-char -1)
)
(not not-found)))
(defsubst plsql-re-search-forward
(regexp &optional bound no-error count limit)
"Search forwards for REGEXP ignoring comments and strings.
Optional parameters BOUND, NO-ERROR and COUNT behave as for `re-search-forward'.
LIMIT is used to bound partial parse and is assumed to be before the current point."
(let ((not-found t)
(limit (or limit 1)))
(while (and not-found
(re-search-forward regexp bound no-error count))
(forward-char -1)
(unless (or (funcall plsql-in-comment-predicate limit)
(funcall plsql-in-string-predicate limit))
(setq not-found nil))
(forward-char 1)
)
(not not-found)))
(defvar plsql-leading-identifier-re ""
"Regexp that will match a PL/SQL identifier." )
(when (plsql-reset plsql-leading-identifier-re)
(setq plsql-leading-identifier-re "^[ \t\n\r]*\\([_#:$a-z,A-Z]+\\)"))
(defvar plsql-sql-statement-re ""
"Regexp matching key terms indicating that we are within an SQL statement.")
(when (plsql-reset plsql-sql-statement-re)
(setq plsql-sql-statement-re
(concat
"\\("
(regexp-opt
(list
"access" "add" "all" "alter" "analyse" "and" "any" "as" "asc"
"audit"
"avg" "between"
"by"
"check" "cluster"
"column" "comment" "commit" "compress" "connect" "continue"
"create" "current"
"declare"
"delete"
"desc" "distinct"
"drop"
"escape"
"exec" "exists" "explain"
"float"
"foreign" "fortran" "found" "from" "go"
"grant" "group" "having" "identified" "immediate" "in" "increment"
"index"
"initial" "insert" "integer"
"into"
"key"
"level" "like" "lock" "long" "max"
"min" "minus"
"mode" "modify" "module" "noaudit"
"not" "nowait" "null"
"numeric" "of" "offline" "on" "online"
"option" "or" "order"
"pctfree" "pli"
"primary" "prior"
"public"
"rename" "resource" "revoke" "revoke" "rollback"
"row" "rowid" "rownum" "rows"
"schema" "section" "select" "session" "set" "share" "size"
"some" "sqlcode" "sqlerror" "start"
"synonym" "sysdate" "table"
"to" "trigger" "truncate"
"uid" "union" "unique" "update" "user" "validate" "values"
"view" "whenever" "where" "with" "work"
))
"\\)"
plsql-white-space-re
)))
(defsubst plsql-sql-statement-adjust ()
"If we are inside an SQL statement returns extra indentation required to line
the last character of the SQL keyword that starts each line."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-sql-statement-adjust 'append))
(save-excursion
(back-to-indentation)
(if (looking-at plsql-sql-statement-re)
(- 8
(length (thing-at-point 'word)))
0)))
(defvar plsql-extra-indent-re ""
"A couple of situations in which we might like to add a little indentation.")
(when (plsql-reset plsql-extra-indent-re)
(setq plsql-extra-indent-re
(concat
"\\b"
(regexp-opt
(list
"in"
"default"
) t )
plsql-white-space-re)
))
(defun plsql-statement-level-adjust (limit indent)
"Adjust the proposed INDENT column at the statement level.
LIMIT marks the beginning of the current statement. Here we deal with the
indentation of SQL keywords starting an SQL block , variable declaration
keywords, and multiline statements"
(when plsql-debug
(add-to-list 'plsql-indent-function-stack
'plsql-statement-level-adjust 'append))
(cond
((looking-at plsql-sql-statement-re)
(+ indent
(- 8
(length (thing-at-point 'word)))))
((looking-at plsql-extra-indent-re)
(+ indent plsql-indent))
((looking-at (concat "then\\|loop\\|is\\|as" plsql-white-space-re))
(if (= (point) limit)
indent
(save-excursion
(goto-char limit)
(current-indentation))))
((save-excursion (plsql-re-search-backward "\n\\|\r" limit t nil limit))
(+ indent plsql-indent))
(t indent)
))
(defun plsql-in-parenthesis-p (limit)
"If inside a parenthesis group, return the column of the open paren,
else return nil. Search bound by LIMIT."
(save-excursion
(let ((parse-sexp-ignore-comments t))
(nth 1 (parse-partial-sexp (point) limit)))))
(defvar plsql-statement-end-re nil
"Regexp matching any kind of statement end.")
(when (plsql-reset plsql-statement-end-re)
(setq plsql-statement-end-re
(concat
"\\("
"" ";"
"\\|"
plsql-white-space-re
(regexp-opt
(list
"loop"
"then"
"else"
"as"
"is"
) t)
"\\)"
plsql-white-space-re
)))
(defun plsql-in-sql-block-p (limit)
"If inside (but not just before) an SQL block, return the adjusted
position of the start of the block the block, otherwise return nil.
Search bound by LIMIT."
(save-excursion
(let ((start (point)))
(when (or (plsql-re-search-backward plsql-statement-end-re
limit t nil limit)
(and (= limit 1) (goto-char 1)))
(when (and (plsql-re-search-forward
(concat plsql-white-space-re plsql-sql-statement-re)
start t nil start)
(progn
(forward-char 1)
(not (plsql-in-parenthesis-p limit))))
(back-to-indentation)
(- (point)
(plsql-sql-statement-adjust))
)))))
(defsubst plsql-indent-to-col (target-col)
"Ensure current indentation is TARGET-COl, but avoid altering the buffer if
no real change need be made."
(unless (eq (current-indentation) target-col)
(delete-horizontal-space)
(indent-to target-col)))
(defun plsql-sql-block-indent (block-start)
"Indent code inside sql block. BLOCK-start is the adjusted position of
the start of the bock."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-sql-block-indent 'append))
(let ((block-col (save-excursion
(goto-char block-start)
(current-column))))
(if (looking-at plsql-sql-statement-re)
(plsql-indent-to-col (+ block-col
(- 8
(length (thing-at-point 'word)))))
(plsql-indent-to-col (save-excursion
(plsql-re-search-backward
(concat plsql-white-space-re plsql-sql-statement-re)
block-start)
(goto-char (match-end 1))
(skip-chars-forward " \t")
(if (looking-at "[\n\r]")
(+ block-col plsql-indent)
(current-column)))))))
(defun plsql-parenthesis-indent (limit)
"Indent code inside parenthesis group. LIMIT is the start of the group."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-paren-indent 'append))
(cond ((looking-at "(")
(plsql-indent-to-col
(save-excursion
(plsql-re-search-backward plsql-leading-identifier-re limit t nil limit)
(goto-char (or (match-beginning 1) 1))
(+ (current-column) plsql-indent))))
((save-excursion
(goto-char limit)
(forward-char 1)
(skip-chars-forward " \t")
(looking-at plsql-sql-statement-re))
(plsql-sql-block-indent (save-excursion
(goto-char (- (match-end 1) 7))
(current-column))))
(t
(plsql-indent-to-col (+ (save-excursion
(goto-char limit)
(forward-char 1)
(skip-chars-forward " \t")
(current-column))
(save-excursion
(back-to-indentation)
(if (looking-at plsql-extra-indent-re)
plsql-indent
0)))
))))
(defvar plsql-exec-sec-stmnt-end-re ""
"Regexp to match the end of a statements in a execution section.
The end of the 1st match should mark the boundary between statements.")
(when (plsql-reset plsql-exec-sec-stmnt-end-re)
(setq plsql-exec-sec-stmnt-end-re
(concat
"\\("
"" ";"
"\\|"
plsql-white-space-re
(regexp-opt
(list
"loop"
"then"
"else"
) t)
"\\)"
plsql-white-space-re
)))
(defvar plsql-open-exec-sec-re ""
"REGEXP matching words that start a new (sub-)section." )
(when (plsql-reset plsql-open-exec-sec-re)
(setq plsql-open-exec-sec-re
(concat
(regexp-opt
(list "if"
"else"
"elsif"
"for"
"while"
"loop"
) t)
plsql-white-space-re
""
)))
(defvar plsql-close-exec-sec-re ""
"REGEXP matching words that end a (sub-)section." )
(when (plsql-reset plsql-close-exec-sec-re)
(setq plsql-close-exec-sec-re
(concat
"\\("
"\\b"
(regexp-opt
(list
"end"
"else"
"elsif"
"exception"
))
plsql-white-space-re
""
"\\|"
"end;"
"\\)"
)))
(defun plsql-exec-sec-indent (limit)
"Indent the current line given that it is inside an execution section.
LIMIT provides a bound for searches and partial scans. The assumption
is that the context of the current line can be completely determined
without reference to any text above that point."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-exec-sec-indent 'append))
(back-to-indentation)
(let ((first-statement nil)
(prev-indent 0)
(prev-type 'plain)
(statement-start (point)))
(save-excursion
(if (plsql-re-search-backward
plsql-exec-sec-stmnt-end-re limit t nil limit)
(progn
(save-excursion
(goto-char (match-end 1))
(when (plsql-re-search-forward
plsql-leading-identifier-re nil t nil limit)
(setq statement-start (match-beginning 1))))
(unless (plsql-re-search-backward
plsql-exec-sec-stmnt-end-re limit t nil limit)
(goto-char limit)
(if (not (looking-at "end"))
(forward-word 1)
(setq first-statement t)
(setq prev-indent (- (current-indentation)
(plsql-sql-statement-adjust))))
)
(unless first-statement
(if (plsql-re-search-forward
plsql-leading-identifier-re
statement-start t nil limit)
(progn
(goto-char (match-beginning 1))
(setq prev-indent (- (current-indentation)
(plsql-sql-statement-adjust)))
(if (looking-at plsql-open-exec-sec-re)
(setq prev-type 'open)))
(setq prev-indent (- (current-indentation)
(plsql-sql-statement-adjust)))
(setq prev-type 'plain-force)
)))
(goto-char limit)
(if (looking-at "begin")
(setq prev-type 'open))
(setq prev-indent (current-indentation))
(forward-word 1)
(if (plsql-re-search-forward
plsql-leading-identifier-re
nil t nil limit)
(goto-char (match-beginning 1)))
(setq statement-start (point))
))
(if (looking-at plsql-close-exec-sec-re)
(if (or (eq prev-type 'open)
(eq prev-type 'plain-force))
(setq prev-type 'plain)
(setq prev-type 'close))
(if (eq prev-type 'plain-force)
(setq prev-type 'plain)))
(let ((new-indent
(cond ((eq prev-type 'open) (+ prev-indent plsql-indent))
((eq prev-type 'close) (- prev-indent plsql-indent))
(t prev-indent))))
(when (>= (point) statement-start)
(setq new-indent (plsql-statement-level-adjust statement-start new-indent)))
(unless (eq (current-indentation) new-indent)
(delete-horizontal-space)
(indent-to new-indent)))
))
(defvar plsql-dec-sec-stmnt-end-re ""
"Regexp to match the end of a statements in a declaration section.
The end of the 1st match should mark the boundary between statements.")
(when (plsql-reset plsql-dec-sec-stmnt-end-re)
(setq plsql-dec-sec-stmnt-end-re
(concat
"\\("
"" ";"
"\\|"
plsql-white-space-re
""
(regexp-opt
(list
"as"
"is"
) t)
"\\)"
plsql-white-space-re
""
)))
(defvar plsql-dec-sec-fake-stmnt-end-re ""
"Regexp matching the start of statements in a declaration section that are not
always ended by something that matches `plsql-dec-sec-stmnt-end-re'. Will be
compared with the first match of `plsql-leading-identifier-re'.")
(when (plsql-reset plsql-dec-sec-fake-stmnt-end-re)
(setq plsql-dec-sec-fake-stmnt-end-re
(concat
plsql-white-space-re
""
(regexp-opt
(list
"cursor"
"type"
"subtype"
"procedure"
"function"
))
plsql-white-space-re
""
)))
(defvar plsql-open-dec-sec-re ""
"REGEXP matching words that start a new declaration (sub-)section.
Note that, since there is little difference between the specification section
and the declaration section, we treat them the same way." )
(when (plsql-reset plsql-open-dec-sec-re)
(setq plsql-open-dec-sec-re
(concat
"\\b"
(regexp-opt
(list "is"
"as"
"procedure"
"function"
"trigger"
"declare"
))
plsql-white-space-re
""
)))
(defvar plsql-close-dec-sec-re ""
"REGEXP matching words that end a declaration (sub-)section.
Note that, since there is little difference between the specification section
and the declaration section, we treat them the same way.")
(when (plsql-reset plsql-close-dec-sec-re)
(setq plsql-close-dec-sec-re
(concat
"\\b"
"\\("
(regexp-opt
(list
"begin"
"is"
"as"
))
plsql-white-space-re
""
"\\|"
"end;"
"\\)"
)))
(defun plsql-dec-sec-indent (limit)
"Indent the current line given that it is inside declaration section."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-dec-sec-indent 'append))
(back-to-indentation)
(let ((prev-indent 0)
(prev-type 'plain)
(statement-start (point)))
(save-excursion
(if (and (plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
(if (save-excursion
(save-match-data
(and
(plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
(plsql-re-search-forward
plsql-leading-identifier-re nil t nil limit)
(goto-char (match-beginning 1))
(looking-at plsql-dec-sec-fake-stmnt-end-re))))
(plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
t))
(progn
(save-excursion
(goto-char (match-end 1))
(when (plsql-re-search-forward
plsql-leading-identifier-re nil t nil limit)
(setq statement-start (match-beginning 1))))
(if (and (plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
(if (save-excursion
(and
(plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
(plsql-re-search-forward
plsql-leading-identifier-re nil t nil limit)
(goto-char (match-beginning 1))
(looking-at plsql-dec-sec-fake-stmnt-end-re)))
(plsql-re-search-backward
plsql-dec-sec-stmnt-end-re limit t nil limit)
t))
(progn
(when (looking-at "[ \t\n\r]*[ia]s[ \t\n\r]")
(forward-word 1))
(when (plsql-re-search-forward
plsql-leading-identifier-re
statement-start t nil limit)
(goto-char (match-beginning 1))
(setq prev-indent (- (current-indentation)
(plsql-sql-statement-adjust)))
))
(goto-char limit)
(setq prev-type 'open)
(setq prev-indent (current-indentation))
))
(goto-char limit)
(back-to-indentation)
(setq prev-indent (current-indentation))
(setq statement-start (point-max))
(setq prev-type 'open)
))
(if (looking-at plsql-close-dec-sec-re)
(if (eq prev-type 'open)
(setq prev-type 'plain)
(setq prev-type 'close)))
(let ((new-indent
(cond ((eq prev-type 'open) (+ prev-indent plsql-indent))
((eq prev-type 'close) (- prev-indent plsql-indent))
(t prev-indent))))
(when (>= (point) statement-start)
(setq new-indent (plsql-statement-level-adjust statement-start new-indent)))
(unless (eq (current-indentation) new-indent)
(delete-horizontal-space)
(indent-to new-indent)))
))
(defvar plsql-except-sec-stmnt-end-re ""
"Regexp to match the end of a statements in a case or exception section.
The end of the 1st match should mark the boundary between statements.")
(when (plsql-reset plsql-except-sec-stmnt-end-re)
(setq plsql-except-sec-stmnt-end-re
(concat
"\\("
"" ";"
"\\|"
plsql-white-space-re
""
(regexp-opt
(list
"then"
"else"
) t)
"\\)"
plsql-white-space-re
""
)))
(defvar plsql-open-execp-sec-re ""
"REGEXP matching words that start a new case or exception (sub-)section." )
(when (plsql-reset plsql-open-execp-sec-re)
(setq plsql-open-execp-sec-re
(concat
(regexp-opt
(list
"exception"
"case"
"when"
"then"
"if"
"else"
) t)
plsql-white-space-re
""
)))
(defvar plsql-close-except-sec-re ""
"REGEXP matching words that end a new case or exception (sub-)section.")
(when (plsql-reset plsql-close-except-sec-re)
(setq plsql-close-except-sec-re
(concat
"\\("
"\\b"
(regexp-opt
(list
"when"
"else"
))
plsql-white-space-re
""
"\\)"
)))
(defvar plsql-block-terminator ""
"Regexp matching the term that terminates a block.")
(when (plsql-reset plsql-block-terminator)
(setq plsql-block-terminator
(concat
"end"
"\\("
";"
"\\|"
plsql-white-space-re
""
"\\)"
)))
(defun plsql-except-sec-indent (limit)
"Indent the current line given that it is inside a case or exception section."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-except-sec-indent 'append))
(back-to-indentation)
(let ((prev-indent 0)
(prev-type 'plain)
(statement-start (point)))
(save-excursion
(if (looking-at plsql-block-terminator)
(progn
(goto-char limit)
(setq prev-indent (current-indentation))
(setq prev-type 'plain))
(if (plsql-re-search-backward
plsql-except-sec-stmnt-end-re limit t nil limit)
(progn
(save-excursion
(goto-char (match-end 1))
(when (plsql-re-search-forward
plsql-leading-identifier-re nil t nil limit)
(setq statement-start (match-beginning 1))))
(back-to-indentation)
(unless (plsql-re-search-backward
plsql-except-sec-stmnt-end-re limit t nil limit)
(goto-char limit)
(forward-word 1))
(when (plsql-re-search-forward
plsql-leading-identifier-re statement-start t nil limit)
(goto-char (match-beginning 1))
(setq prev-indent (- (current-indentation)
(plsql-sql-statement-adjust)))
(if (looking-at plsql-open-execp-sec-re)
(setq prev-type 'open))
))
(goto-char limit)
(skip-chars-forward " \t")
(setq prev-indent (current-indentation))
(if (not (looking-at "case"))
(forward-word 1)
(forward-word 1)
(skip-chars-forward " \t")
(skip-chars-forward "^ \t"))
(if (plsql-re-search-forward plsql-leading-identifier-re
nil t nil limit)
(goto-char (match-beginning 1)))
(setq statement-start (point))
(setq prev-type 'open-force)
))
)
(if (and (looking-at plsql-close-except-sec-re))
(if (eq prev-type 'open)
(setq prev-type 'plain)
(if (eq prev-type 'open-force)
(setq prev-type 'open)
(setq prev-type 'close))))
(let ((new-indent
(cond ((eq prev-type 'open) (+ prev-indent plsql-indent))
((eq prev-type 'open-force) (+ prev-indent plsql-indent))
((eq prev-type 'close) (- prev-indent plsql-indent))
(t prev-indent))))
(when (>= (point) statement-start)
(setq new-indent (plsql-statement-level-adjust statement-start new-indent)))
(unless (eq (current-indentation) new-indent)
(delete-horizontal-space)
(indent-to new-indent)))
))
(defun plsql-package-indent (limit)
"Indent the current line given that it is outside a module
definition. Really this is for indenting package variables, first
line of a module, and the \"begin\" at the start of a packages
executable block."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-package-indent 'append))
(back-to-indentation)
(let ((new-indent
(save-excursion
(cond ((looking-at "\\<begin\\>[ \t\n\r]+\\|^[ \t]*$")
(goto-char limit)
(- (current-indentation) plsql-indent))
((looking-at "/\\|\\bend\\b")
0)
((looking-at "--\\|\\b\\(procedure\\|function\\|trigger\\)\\b")
plsql-indent)
((looking-at
"\\<create\\>\\([ \t\n\r]+or[ \t\n\r]+replace\\)?[ \t\n\r]+\\(\\w+\\)")
(if (string-match "procedure\\|function\\|trigger"
(match-string 1))
plsql-indent 0))
((looking-at "package")
0)
(t
nil)))))
(if (not new-indent)
(plsql-dec-sec-indent limit)
(unless (= (current-indentation) new-indent)
(delete-horizontal-space)
(indent-to new-indent)))
))
(defvar plsql-top-level-flush-re ""
"Regexp matching the start of top level statements that should be eft flush.")
(when (plsql-reset plsql-top-level-flush-re)
(setq plsql-top-level-flush-re
(regexp-opt
(list
"create"
"begin"
"declare"
"function"
"procedure"
"trigger"
"package"
) 'word)
))
(defun plsql-top-level-indent (limit)
"The last nail in the coffin for a really rare case. Everything
outside of a package body or spec is left flushed."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-top-level-indent 'append))
(back-to-indentation)
(plsql-indent-to-col
(if (looking-at plsql-top-level-flush-re)
0
(plsql-statement-level-adjust (point) 0))))
(defvar plsql-section-start-re ""
"Regexp matching the beginning of (or a boundary within) a new type
of section.")
(when (plsql-reset plsql-section-start-re)
(setq plsql-section-start-re
(concat
"\\(?:"
"^\\|"
plsql-white-space-re
"\\)"
(regexp-opt
(list
"end"
"begin"
"declare"
"function"
"procedure"
"trigger"
"package"
) t)
"\\(;"
"\\|"
plsql-white-space-re
"\\)"
)))
(defun plsql-comment-indent (&optional start)
"Indent the current line at least as much as the previous."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-comment-indent 'append))
(let ((new-indent (save-excursion
(condition-case nil
(forward-line -1)
(error nil))
(current-indentation))))
(unless (> (current-indentation) new-indent)
(delete-horizontal-space)
(indent-to new-indent)))
)
(defun plsql-after-end-indent (limit)
"Indent line following a an \"end\" keyword that begins at
LIMIT. Determines the context and passes the job on to the appropriate
indentation function."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-after-end-indent 'append))
(let (indent-function match)
(if (save-excursion
(goto-char (+ limit 3))
(skip-chars-forward " \t\n\r")
(looking-at "\\(if\\|loop\\|case\\)[ \t\n\r]*;"))
(setq indent-function 'plsql-exec/except-sec-indent)
(save-excursion
(goto-char limit)
(let ((end-indent (current-indentation)))
(while (and
(> end-indent 0)
(plsql-re-search-backward plsql-section-start-re nil t nil nil)
(goto-char (match-beginning 1))
(>= (current-indentation) end-indent)))))
(setq match (downcase (match-string 1)))
(setq limit (match-beginning 1))
(cond ((string-match "begin\\|end" match)
(setq indent-function 'plsql-exec-sec-indent))
((or (string-equal "procedure" match)
(string-equal "function" match))
(setq indent-function 'plsql-dec-sec-indent))
((string-equal "package" match)
(setq indent-function 'plsql-package-indent))
(t
(message "unpackaged block")
(setq indent-function 'plsql-top-level-indent))
))
(funcall indent-function limit)))
(defun plsql-exec/except-sec-indent (limit)
"Special case: exception keyword is also a type so we can't use it
as a section start keyword. We have to do this outside of the first
save-excursion of `plsql-indent'."
(when plsql-debug
(add-to-list 'plsql-indent-function-stack 'plsql-exec/except-sec-indent 'append))
(let ((indent-function 'plsql-exec-sec-indent))
(save-excursion
(back-to-indentation)
(when (plsql-re-search-backward "[ \t\n\r]\\(exception\\|case\\)[ \t\n\r]"
limit t nil limit)
(setq limit (match-beginning 1))
(unless (and (string-equal "case" (match-string 1))
(back-to-indentation)
(looking-at "end"))
(setq indent-function 'plsql-except-sec-indent))
))
(funcall indent-function limit)
))
(defun plsql-indent ()
"Indent the current line appropriate to the current structural unit."
(interactive)
(let ((target-col nil)
(target-start nil)
(indent-function nil)
(limit 1)
(match nil)
(in-comment-p nil)
(in-string-p nil)
(case-fold-search t))
(save-excursion
(back-to-indentation)
(cond (
(and (funcall plsql-in-comment-predicate 1)
(not (looking-at "--")))
(setq in-comment-p t))
(
(and (funcall plsql-in-string-predicate 1)
(not (looking-at "'")))
(setq in-string-p t))
(
(plsql-re-search-backward
plsql-section-start-re nil t nil nil)
(setq match (downcase (match-string 1)))
(setq limit (match-beginning 1))
(cond ((string-equal "end" match)
(setq indent-function 'plsql-after-end-indent))
((string-equal "begin" match)
(setq indent-function 'plsql-exec/except-sec-indent))
((string-equal "declare" match)
(setq indent-function 'plsql-dec-sec-indent))
((or (string-equal "procedure" match)
(string-equal "function" match))
(plsql-re-search-forward
plsql-dec-sec-stmnt-end-re
nil t nil limit)
(if (string-match "is\\|as" (or (match-string 1) "dummy"))
(setq indent-function 'plsql-dec-sec-indent)
(setq indent-function 'plsql-package-indent)))
((string-equal "package" match)
(setq indent-function 'plsql-package-indent))
))
(t
(setq limit 1)
(cond ((plsql-re-search-backward
plsql-exec-sec-stmnt-end-re nil t nil nil)
(setq indent-function 'plsql-exec/except-sec-indent))
((looking-at plsql-section-start-re)
(setq indent-function 'plsql-package-indent))
(t
(setq indent-function 'plsql-top-level-indent)
)))
))
(setq plsql-indent-function-stack nil)
(save-excursion
(back-to-indentation)
(when (and (not in-comment-p) (not in-string-p))
(cond (
(setq target-col (plsql-in-parenthesis-p limit))
(setq indent-function 'plsql-parenthesis-indent)
(setq limit target-col))
(
(setq target-start (plsql-in-sql-block-p limit))
(setq indent-function 'plsql-sql-block-indent)
(setq limit target-start))
))
(when indent-function
(when plsql-debug
(add-to-list 'plsql-indent-function-stack indent-function 'append))
(funcall indent-function limit)))
(if (= (current-column) 0) (skip-chars-forward " \t"))
(when plsql-debug
(message "%s"
(mapconcat
(lambda (x)
(when x (substring (substring (symbol-name x) 6) 0 -7)))
plsql-indent-function-stack
" -> ")))
))
(eval-and-compile (require 'imenu))
(defvar plsql-imenu-title "Contents"
"*Title of the menu which will be added to the menu bar.")
(defvar plsql-imenu-regexp ""
"*A regular expression matching a head line to be added to the menu.")
(when (plsql-reset plsql-imenu-regexp)
(setq plsql-imenu-regexp
(concat
"\\(?:"
"^\\|"
plsql-white-space-re
"\\)"
"\\("
"" "package"
"\\|" "function"
"\\|" "procedure"
"\\)"
plsql-white-space-re
)))
(eval-when-compile (require 'cl))
(defun plsql-imenu-index ()
"Return an table of contents for an PL/SQL buffer for use with Imenu."
(interactive)
(let ((case-fold-search t)
(toc-string nil)
(procedure-alist '())
(variable-alist '())
(function-alist '())
(type-alist '())
(package-alist '())
(index-alist '())
(in-body nil)
(body-defn nil)
(spec-defn nil)
(package nil)
prev-pos
match start end indent)
(save-excursion
(goto-char (point-max))
(imenu-progress-message prev-pos 0)
(while (and (plsql-re-search-backward plsql-imenu-regexp nil t)
(not (funcall plsql-in-string-predicate 1)))
(imenu-progress-message prev-pos nil t)
(setq end (match-end 1)
start (match-beginning 1)
match (downcase (match-string 1)))
(goto-char start)
(beginning-of-line)
(setq indent (/ (current-indentation) plsql-indent))
(setq indent (if (< indent 2) ""
(make-string (* (- indent 1) 2) ?\ )))
(goto-char end)
(save-excursion
(skip-chars-forward "[ \t\n\r]+")
(when (looking-at "body")
(setq in-body t)
(forward-word 1)
(skip-chars-forward "[ \t\n\r]+"))
(setq toc-string (concat indent (thing-at-point 'symbol)))
(cond ((string-equal match "procedure")
(push (cons toc-string (point)) procedure-alist))
((string-equal match "function")
(push (cons toc-string (point)) function-alist))
((string-equal match "type")
(push (cons toc-string (point)) type-alist))
((string-equal match "package")
(if in-body
(progn
(setq package (concat toc-string" body"))
(setq body-defn t))
(setq package (concat toc-string" spec"))
(setq spec-defn t))
(if procedure-alist
(if (or function-alist type-alist)
(push (cons "Procedures" procedure-alist) package-alist)
(setq package-alist procedure-alist)))
(if function-alist
(if (or procedure-alist type-alist)
(push (cons "Functions" function-alist) package-alist)
(setq package-alist function-alist)))
(if type-alist
(if (or procedure-alist function-alist)
(push (cons "Types" type-alist) package-alist)
(setq package-alist type-alist)))
(when package-alist
(push (cons package package-alist) index-alist))
(setq procedure-alist '()
function-alist '()
type-alist '()
package-alist '()
in-body nil))
(t
(push (cons toc-string (point)) variable-alist)
))
)
(goto-char start)
))
(imenu-progress-message prev-pos 100)
(unless package
(if procedure-alist
(if (or function-alist type-alist)
(push (cons "Procedures" procedure-alist) index-alist)
(setq index-alist procedure-alist)))
(if function-alist
(if (or procedure-alist type-alist)
(push (cons "Functions" function-alist) index-alist)
(setq index-alist function-alist)))
(if type-alist
(if (or procedure-alist function-alist)
(push (cons "Types" type-alist) index-alist)
(setq index-alist type-alist))))
(unless (and body-defn spec-defn)
(setq index-alist (cdr (car index-alist))))
index-alist))
(defun plsql-imenu-setup ()
"*Setup the variables to support imenu."
(interactive)
(setq imenu-case-fold-search t)
(setq imenu-sort-function nil)
(setq imenu-create-index-function 'plsql-imenu-index)
(imenu-add-to-menubar plsql-imenu-title)
)
(eval-and-compile
(defcustom plsql-align-rules-list '() ""
:group 'plsql
:type 'align-rules-list-type)
(when (condition-case nil
(require 'align)
(error nil))
(unless (and plsql-align-rules-list plsql-debug)
(setq plsql-align-rules-list
'(
(plsql-assignment
(regexp . "\\(\\s-*\\):=\\(\\s-*\\)")
(group . (1 2))
(modes . '(plsql-mode))
(repeat t)
(tab-stop . nil))
(plsql-arrorw
(regexp . "\\(\\s-*\\)=>\\(\\s-*\\)")
(group . (1 2))
(modes . '(plsql-mode))
(repeat t)
(tab-stop . nil))
(plsql-equals
(regexp . "\\(\\s-*[^:]\\)=\\([^>]\\s-*\\)")
(group . (1 2))
(repeat t)
(tab-stop . nil)
(modes . '(plsql-mode)))
(plsql-operator
(regexp . "\\(\\s-*\\)[-+/]{1}\\(\\s-*\\)")
(group . (1 2))
(repeat t)
(tab-stop . nil)
(modes . '(plsql-mode)))
(plsql-keywords
(regexp . "\\(\\s-+\\)\\(in\\|default\\|number\\|varchar2\\|blob\\|raw\\)\\b")
(group 1)
(repeat t)
(case-fold t)
(tab-stop . nil)
(modes . '(plsql-mode)))
)
))
(put 'plsql-align-rules-list 'risky-local-variable t)
(add-to-list 'align-c++-modes 'plsql-mode)
(add-to-list 'align-sq-string-modes 'plsql-mode)
(add-to-list 'align-open-comment-modes 'plsql-mode)
))
(defvar plsql-oracle-font-lock-fix-re "")
(when (or (null plsql-oracle-font-lock-fix-re) plsql-debug)
(setq plsql-oracle-font-lock-fix-re
(list (cons
(concat
"\\b" "\\(" (regexp-opt
(list
"if"
"then"
"when"
"else"
"elsif"
"begin"
"end"
"loop"
"for"
"while"
"return"
"exit"
)) "\\)" "\\b")
'font-lock-keyword-face)
(cons
(concat
"\\b" "\\(" (regexp-opt
(list
"true"
"false"
"number"
"raw"
)) "\\)" "\\b")
'font-lock-type-face)
(cons
(concat
"\\b" "\\(" (regexp-opt
(list
"open"
"fetch"
"close"
"count"
)) "\\)" "\\b")
'font-lock-builtin-face)
(cons
"%[_#:$a-z,A-Z]+"
'font-lock-constant-face)
(cons
(concat
"\\b"
"\\(" "function"
"\\|" "procedure"
"\\|" "package body"
"\\|" "package"
"\\)"
plsql-white-space-re
"\\([_#:$a-z,A-Z]+\\)")
(list
'(1 font-lock-type-face)
'(2 font-lock-function-name-face))
)
(cons
(concat
"\\b" "\\(" (regexp-opt
(list
"language"
)) "\\)" "\\b")
''default)
)))
(eval-when-compile (require 'sql))
(defun plsql-indent-region (beg end)
"Indent the region between BEG and END with a progress display."
(interactive "*r")
(goto-char beg)
(let* ((line-count (count-lines beg end))
(lines-indented 0)
(lines-remaining line-count)
(endmark (copy-marker end)))
(while (< (point) endmark)
(when (> lines-indented 39)
(setq lines-remaining (- lines-remaining lines-indented)
lines-indented 0)
(message "Indenting region...(%d%%)"
(/ (* (- line-count lines-remaining) 100) line-count)))
(plsql-indent)
(forward-line 1)
(setq lines-indented (1+ lines-indented)))
(message "Indenting region...done")))
(defun plsql-mode ()
"Programming support mode for PL/SQL code."
(interactive)
(require 'sql)
(setq sql-mode-font-lock-keywords
(append plsql-oracle-font-lock-fix-re
sql-mode-oracle-font-lock-keywords))
(setq font-lock-mark-block-function 'mark-visible)
(sql-mode)
(setq major-mode 'plsql-mode)
(setq mode-name "PL/SQL")
(if plsql-uses-font-lock
(progn
(setq plsql-in-comment-predicate 'plsql-comment-face-p)
(setq plsql-in-string-predicate 'plsql-string-face-p))
(setq plsql-in-comment-predicate 'plsql-in-comment-p)
(setq plsql-in-string-predicate 'plsql-in-string-p))
(plsql-imenu-setup)
(set (make-local-variable 'indent-line-function) 'plsql-indent)
(set (make-local-variable 'indent-region-function) 'plsql-indent-region)
(set (make-local-variable 'align-mode-rules-list) 'plsql-align-rules-list)
(local-set-key [(return)] 'newline-and-indent)
(run-hooks 'plsql-mode-hook)
)
(provide 'plsql)