Download
(defcustom sql-into-clause-at-the-end nil
"*If t, add INTO clause at the end of a SELECT statement.
If nil, add INTO clause before the FROM clause."
:type 'boolean
:group 'SQL)
(defvar sql-keyword-regexp "[ \t\n]*\\(from\\|into\\|where\\|group\\|order\\|set\\)\\b"
"Regexp matching SQL keywords within a SQL statement.
This is used to end the parsing of a SET clause in UPDATE statements, a
column list in SELECT statements, etc. See also `sql-end-where-regexp'.")
(defvar sql-end-where-regexp "\\binto\\b"
"Regexp matching the end of a WHERE clause.
A WHERE clause is also ended by `sql-statement-end-regexp'.
This doesn't include GROUP BY and ORDER BY clauses because these are
included in the WHERE clause for simplicity.")
(defvar sql-statement-start-regexp "\\b\\(select\\|insert\\|update\\|delete\\)\\b"
"Regexp matching SQL keywords starting a SQL statement.
This is used in `sql-identify-statement'.
If you want to add more keywords, be sure to define a sql-to-KEYWORD and
sql-parse-KEYWORD function. Those functions will be called from
`sql-parse-statement' and `sql-rewrite'")
(defvar sql-statement-end-regexp "[ \t\n]*\\([;)]\\|\n\n\\|\n\n?\\'\\|\\'\\)"
"Regexp matching the end of a SQL statement.")
(defvar sql-insert-newline-regexp "\\b\\(and\\|or\\)\\b"
"Regexp that matches newline insertion points within a WHERE clause.
See also `sql-insert-newline-and-indent-regexp'. Leading whitespace is
not necessary as it is stripped in `sql-parse-where'.")
(defvar sql-insert-newline-and-indent-regexp "([ \t\n]*select\\b"
"Regexp that matches newline-and-indent points within a WHERE clause.
See also `sql-insert-newline-regexp'. Leading whitespace is not
necessary as it is stripped in `sql-parse-where'. The expression will
be indented by `sql-indent-string' and rewritten later using `sql-rewrite'.")
(defvar sql-indent-string " "
"String used to indent an expression.
This expression is matched by `sql-insert-newline-and-indent-regexp' in
`sql-parse-where'.")
(defun sql-to-update ()
"Convert SQL statement at point to an UPDATE statement.
Any SQL statement that can by parsed by `sql-parse-statement' will do.
The boundaries of the SQL statement are guessed by
`sql-statement-find-start' and `sql-statement-find-end'."
(interactive)
(let* ((start (sql-statement-find-start))
(end (sql-statement-find-end start))
(statement (sql-parse-statement start end))
(table (car (nth 0 statement)))
(where (nth 1 statement))
(columns (nth 2 statement))
(bindvars (nth 3 statement))
(target-column))
(goto-char start)
(setq target-column (current-column))
(kill-region start end)
(insert "UPDATE " table " SET")
(while columns
(newline 1)
(indent-to target-column)
(insert (format " %s = %s" (car columns) (car bindvars)))
(if (cdr columns)
(insert ","))
(setq columns (cdr columns)
bindvars (cdr bindvars)))
(if where
(progn
(newline 1)
(indent-to target-column)
(sql-insert-where-clause where target-column)))))
(defun sql-to-insert ()
"Convert SQL statement at point to an INSERT statement.
Any SQL statement that can by parsed by `sql-parse-statement' will do.
The boundaries of the SQL statement are guessed by
`sql-statement-find-start' and `sql-statement-find-end'."
(interactive)
(let* ((start (sql-statement-find-start))
(end (sql-statement-find-end start))
(statement (sql-parse-statement start end))
(table (car (nth 0 statement)))
(where (nth 1 statement))
(columns (nth 2 statement))
(bindvars (nth 3 statement))
(no-newlines (< (length columns) 6))
(target-column))
(goto-char start)
(setq target-column (current-column))
(kill-region start end)
(insert "INSERT INTO " table " (")
(if no-newlines
(insert " ")
(newline 1)
(indent-to target-column)
(insert " "))
(insert (car columns))
(setq columns (cdr columns))
(while columns
(insert ",")
(if no-newlines
(insert " ")
(newline 1)
(indent-to target-column)
(insert " "))
(insert (car columns))
(setq columns (cdr columns)))
(insert " )")
(newline 1)
(indent-to target-column)
(insert "VALUES ( " (car bindvars))
(setq bindvars (cdr bindvars))
(while bindvars
(insert ",")
(if no-newlines
(insert " ")
(newline 1)
(indent-to target-column)
(insert " "))
(insert (car bindvars))
(setq bindvars (cdr bindvars)))
(insert " )")))
(defun sql-to-select ()
"Convert SQL statement at point to a SELECT statement.
Any SQL statement that can by parsed by `sql-parse-statement' will do.
The boundaries of the SQL statement are guessed by
`sql-statement-find-start' and `sql-statement-find-end'."
(interactive)
(let* ((start (sql-statement-find-start))
(end (sql-statement-find-end start))
(statement (sql-parse-statement start end))
(tables (nth 0 statement))
(where (nth 1 statement))
(columns (nth 2 statement))
(bindvars (nth 3 statement))
(no-newlines (< (length columns) 6))
(target-column))
(goto-char start)
(setq target-column (current-column))
(kill-region start end)
(insert (format "SELECT %s" (car columns)))
(setq columns (cdr columns))
(while columns
(insert ",")
(if no-newlines
(insert " ")
(newline 1)
(indent-to target-column)
(insert " "))
(insert (car columns))
(setq columns (cdr columns)))
(newline 1)
(indent-to target-column)
(if (null sql-into-clause-at-the-end)
(sql-insert-into-clause bindvars no-newlines target-column))
(insert "FROM " (car tables))
(setq tables (cdr tables))
(while tables
(insert ", " (car tables))
(setq tables (cdr tables)))
(if where
(progn
(newline 1)
(indent-to target-column)
(sql-insert-where-clause where target-column)))
(if sql-into-clause-at-the-end
(progn
(newline 1)
(indent-to target-column)
(sql-insert-into-clause bindvars no-newlines target-column)))))
(defun sql-insert-into-clause (bindvars no-newlines target-column)
"Insert INTO clause for SELECT statements.
First parameter BINDVARS contains a list of bindvars to use.
If second parameter NO-NEWLINES is t, add no newlines between bindvars.
Third parameter TARGET-COLUMN says where to indent bindvars to. Point
should be at this column when this function is called.
See `sql-to-select' for more information."
(if bindvars
(progn
(insert (format "INTO %s" (car bindvars)))
(setq bindvars (cdr bindvars))
(while bindvars
(insert ",")
(if no-newlines
(insert " ")
(newline 1)
(indent-to target-column)
(insert " "))
(insert (car bindvars))
(setq bindvars (cdr bindvars)))
(newline 1)
(indent-to target-column))))
(defun sql-to-delete ()
"Convert SQL statement at point to a DELETE statement.
Any SQL statement that can by parsed by `sql-parse-statement' will do.
The boundaries of the SQL statement are guessed by
`sql-statement-find-start' and `sql-statement-find-end'."
(interactive)
(let* ((start (sql-statement-find-start))
(end (sql-statement-find-end start))
(statement (sql-parse-statement start end))
(table (car (nth 0 statement)))
(where (nth 1 statement))
(target-column))
(goto-char start)
(setq target-column (current-column))
(kill-region start end)
(insert "DELETE FROM " table)
(if where
(progn
(newline 1)
(indent-to target-column)
(sql-insert-where-clause where target-column)))))
(defun sql-insert-where-clause (lines target-column)
"Insert WHERE clause at point.
First parameter LINES is a list of lines, second parameter
TARGET-COLUMN is the target column at which the WHERE string
should start."
(let ((line)
(markers)
(first t))
(insert "WHERE ")
(while lines
(if first
(setq first nil)
(newline 1)
(indent-to target-column))
(setq line (car lines)
lines (cdr lines))
(insert line)
(save-excursion
(beginning-of-line)
(upcase-word 1))
(while (char-equal (char-before) 32)
(delete-char -1))
(if (string-match (concat "^" sql-indent-string) line)
(add-to-list 'markers
(set-marker (make-marker)
(save-excursion (search-backward ")"))))))
(while markers
(goto-char (car markers))
(set-marker (car markers) nil)
(setq markers (cdr markers))
(sql-rewrite))))
(defun sql-rewrite ()
"Rewrite SQL statement at point.
Any SQL statement that can by parsed by `sql-parse-statement' will do.
This works like a pretty printer of SQL statements.
The boundaries of the SQL statement are guessed by
`sql-statement-find-start' and `sql-statement-find-end'."
(interactive)
(let* ((start (sql-statement-find-start))
(end (sql-statement-find-end start))
(type (sql-identify-statement start end))
(func (intern-soft (concat "sql-to-" type))))
(if func
(funcall func)
(error "%s statements cannot be rewritten" (upcase type)))))
(defun sql-statement-find-start ()
"Return start of SQL statement at point.
This uses `sql-statement-start-regexp'."
(save-excursion
(skip-syntax-forward " ")
(while (and (not (looking-at sql-statement-start-regexp))
(> (point) (point-min)))
(forward-sexp -1))
(if (looking-at sql-statement-start-regexp)
(point)
(error "Cannot find start of SQL statement."))))
(defun sql-statement-find-end (start)
"Return end of SQL statement starting at START.
This uses `sql-statement-end-regexp'."
(save-excursion
(goto-char start)
(while (not (looking-at sql-statement-end-regexp))
(forward-sexp))
(point)))
(defun sql-identify-statement (start end)
"Identify the SQL statement between START and END.
The two arguments START and END are character positions.
The function returns a downcased string containing the SQL statement
type, eg. \"select\".
This uses `sql-statement-start-regexp'."
(goto-char start)
(or (re-search-forward sql-statement-start-regexp end t)
(error "No SQL statement found"))
(downcase (match-string 1)))
(defun sql-parse-statement (start end)
"Parse a SQL statement and return the parsed statement.
The two arguments START and END are character positions.
The value returned is a list (TABLES WHERE COLUMNS BINDVARS). TABLES is
the list of tables, WHERE is the where clause of the statement, COLUMNS
is a list of column names, and BINDVARS is a list of bindvariables.
BINDVARS may be an empty list.
A possible result would be
\((\"EMP\") \"WHERE EMPNO = 1\" (\"EMPNO\" \"NAME\") (\"v_empno\", \"v_name\"))"
(goto-char start)
(let* ((type (sql-identify-statement start end))
(func (intern-soft (concat "sql-parse-" type))))
(if func
(funcall func start end)
(error "%s statements cannot be parsed" (upcase type)))))
(defun sql-parse-select (start end)
"Parse the region for a SELECT statement and return the parsed statement.
The two arguments START and END are character positions.
See `sql-parse-statement' for more information."
(let ((columns)
(bindvars)
(tables)
(where))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bselect\\b" end)
(setq columns (sql-parse-csv (point) end)))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\binto\\b" end)
(setq bindvars (sql-parse-csv (point) end)))
(if (and bindvars
(not (= (length columns)
(length bindvars))))
(message "Parser warning: not the same number of columns and bindvars"))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bfrom\\b" end)
(setq tables (sql-parse-csv (point) end))
(error "FROM clause missing"))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bwhere\\b" end)
(setq where (sql-parse-where (point) end)))
(list tables where columns bindvars)))
(defun sql-parse-insert (start end)
"Parse the region for an INSERT statement and return the parsed statement.
The two arguments START and END are character positions.
See `sql-parse-statement' for more information."
(let ((columns)
(bindvars)
(table))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\binsert[ \t\n]+into[ \t\n]+\\(\\(\\sw\\|\\s_\\)+\\)" end)
(setq table (list (match-string 1)))
(error "INTO clause missing"))
(if (re-search-forward "\\=[ \t\n]*(" end t)
(setq columns (sql-parse-csv (point) end)))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bvalues[ \t\n]*(" end)
(setq bindvars (sql-parse-csv (point) end)))
(if (not (= (length columns)
(length bindvars)))
(message "Parser warning: not the same number of columns and bindvars"))
(list table nil columns bindvars)))
(defun sql-parse-update (start end)
"Parse the region for an UPDATE statement and return the parsed statement.
The two arguments START and END are character positions.
See `sql-parse-statement' for more information."
(let ((columns)
(bindvars)
(table)
(where))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bupdate\\b" end)
(setq table (sql-parse-csv (point) end))
(error "Table missing"))
(if (sql-find-regexp "[ \t\n]*\\bset\\b" end)
(let ((assignments (sql-parse-assignments (point) end)))
(setq columns (car assignments)
bindvars (cdr assignments))))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bwhere\\b" end)
(setq where (sql-parse-where (point) end)))
(list table where columns bindvars)))
(defun sql-parse-delete (start end)
"Parse the region for a DELETE statement and return the parsed statement.
The two arguments START and END are character positions.
See `sql-parse-statement' for more information."
(let ((table)
(where))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bdelete[ \t\n]+from\\b" end)
(setq table (sql-parse-csv (point) end))
(error "Table missing"))
(goto-char start)
(if (sql-find-regexp "[ \t\n]*\\bwhere\\b" end)
(setq where (sql-parse-where (point) end)))
(list table where nil nil)))
(defun sql-parse-csv (start end)
"Parse a list of comma separated values and return them as a list.
The two arguments START and END are character positions.
A value may contain any characters, but all parenthesises must be
balanced if they are not within a string, and all quotes must balance.
This is achieved by using `forward-sexp'. The list ends when a word
outside a string matches `sql-keyword-regexp' or END is reached."
(goto-char start)
(let ((words)
(pos))
(while (and (not (looking-at sql-keyword-regexp))
(not (looking-at "[ \t\n]*)"))
(<= (point) end))
(forward-sexp)
(if (or (looking-at "[ \t\n]*[,)]")
(looking-at sql-keyword-regexp)
(looking-at sql-statement-end-regexp)
(= (point) end))
(progn
(setq pos (match-end 0))
(add-to-list 'words
(sql-trim
(buffer-substring-no-properties start (point))))
(setq start pos))))
(nreverse words)))
(defun sql-parse-assignments (start end)
"Parse a list of assignments.
The region between START and END is parsed and returned as two lists
in a cons cell.
An assignment consists of a word, an equal sign, and a value. A word is
a string consisting of word characters as well as `_' and `.'
characters. A value may contain any characters, but all parenthesises
must be balanced if they are not within a string, and all quotes must
balance. This is achieved by using `forward-sexp'. The assignment ends
when a word outside a string matches `sql-keyword-regexp' or END is
reached."
(goto-char start)
(let* ((columns)
(bindvars)
(current-list)
(pos))
(while (and (not (looking-at sql-keyword-regexp))
(< (point) end))
(forward-sexp)
(cond ((looking-at "[ \t\n]*=")
(setq current-list 'columns))
((or (looking-at "[ \t\n]*,")
(looking-at sql-keyword-regexp))
(setq current-list 'bindvars)))
(if current-list
(progn
(setq pos (match-end 0))
(add-to-list current-list
(sql-trim
(buffer-substring-no-properties start (point))))
(setq start pos
current-list nil))))
(cons (nreverse columns) (nreverse bindvars))))
(defun sql-parse-where (start end)
"Parse a WHERE clause into a list of lines.
The region between START and END is parsed. A new line is started
whenever `sql-insert-newline-regexp' or
`sql-insert-newline-and-indent-regexp' matches.
Whitespace is collapsed. Leading whitespace is stripped."
(goto-char start)
(setq start (re-search-forward "\\s *"))
(let ((lines)
(line)
(done nil))
(while (and (not done)
(<= (point) end))
(cond (
(looking-at "[ \t\n]+")
(setq line (concat line
(buffer-substring-no-properties start (point))
" ")
start (match-end 0))
(goto-char start))
((looking-at sql-insert-newline-and-indent-regexp)
(setq line (concat line
(buffer-substring-no-properties start (point)))
start (point))
(if (> (length line) 0)
(add-to-list 'lines line))
(setq line sql-indent-string)
(goto-char start)
(forward-sexp))
((looking-at sql-insert-newline-regexp)
(setq line (concat line
(buffer-substring-no-properties start (point)))
start (match-end 0))
(if (> (length line) 0)
(add-to-list 'lines line))
(setq line (match-string-no-properties 0))
(goto-char start))
((and (looking-at "[()]+")
(< (point) end))
(setq line (concat line
(buffer-substring-no-properties start (point))
(match-string-no-properties 0))
start (match-end 0))
(goto-char start))
((or (looking-at sql-end-where-regexp)
(= (point) end))
(setq done t))
(t
(forward-sexp))))
(setq line (concat line
(buffer-substring-no-properties start (point))))
(if (> (length line) 0)
(add-to-list 'lines line))
(nreverse lines)))
(defun sql-trim (str)
"Trim left and right whitespace.
Whitespace in the middle of STR is left untouched."
(let ((mystr str))
(when (string-match "^[ \t\n]+" mystr)
(setq mystr (substring mystr (match-end 0))))
(when (string-match "[ \t\n]+$" mystr)
(setq mystr (substring mystr 0 (match-beginning 0))))
mystr))
(defun sql-find-regexp (regexp limit)
"Find REGEXP while skipping all sexps.
Return point or nil if not found before LIMIT.
Skipping sexps will skip strings and parenthetical groups."
(let ((found (looking-at regexp)))
(while (and (not found)
(<= (point) limit)
(condition-case nil
(progn
(forward-sexp 1)
t)
(scan-error nil)))
(setq found (looking-at regexp)))
(if (and found
(<= (match-end 0) limit))
(goto-char (match-end 0)))))
(provide 'sql-transform)