;; SQL-Mode.el -- A major mode for editing SQL queries.
;; Currently only hase the mode function, a hook, and variables 
;;  for fontification through font-lock-mode.
;;
;; Author: Zastai <zastai@hotmail.com>
;; Keywords: languages

;;; Commentary:

;; Currently only has fontification and up/downcasing of keywords.

;;; Code:

(eval-and-compile
  (condition-case ()
      (require 'custom)
    (error nil))
  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
      nil
    (defmacro defgroup (&rest args)
      nil)
    (defmacro defcustom (var value doc &rest args)
      (` (defvar (, var) (, value) (, doc))))))

(defgroup sql-mode nil
  "A major mode for editing SQL queries."
  :tag "SQL Mode"
  :group 'languages
  )

(defcustom sql-mode-hook nil
  "*Hook run at startup by `sql-mode'."
  :type 'hook
  :tag "SQL Mode Hook"
  :group 'sql-mode
  )

(defcustom sql-keywords-anycase t
  "*Default behaviour of SQL keyword fontification.
Used by `sql-mode' to determine wheter to use case-sensitive or insensitive
fontification. This behaviour can be changed at any time by calling 
`sql-set-keyword-case'."
  :type 'boolean
  :tag "SQL Keywords Case Insensitive"
  :group 'sql-mode
  )

(defconst sql-query-functions
  ;; AVG, COUNT, MIN, MAX, STDEV, STDEVP, SUM, VAR, VARP
  "AVG\\|COUNT\\|M\\(IN\\|AX\\)\\|S\\(TDEV[P]?\\|UM\\)\\|VAR[P]"
  "Regexp that expands to all supported SQL aggregate functions.

These are:
  Avg
  Count
  Min/Max
  StDev (and StDevp)
  Sum
  Var (and Varp)
")

(defconst sql-query-data-types
  (concat ""
	  ;; A - ALPHANUMERIC, AUTOINCREMENT 
	  "A\\(LPHANUMERIC\\|UTOINCREMENT\\)\\|"
	  ;; B - BINARY, BIT (VARYING),  BOOLEAN, BYTE
	  "B\\(I\\(NARY\\|T\\([ \t\n]+VARYING\\|\\)\\)\\|OOLEAN\\|YTE\\)\\|"
	  ;; C - CHAR(ACTER) (VARYING), COUNTER, CURRENCY
	  "C\\(HA\\(R\\(ACTER\\([ \t\n]+VARYING\\|\\)\\|\\)\\)\\|OUNTER\\|"
	  "URRENCY\\)\\|"
	  ;; D - DATE, DATETIME, DECIMAL, DOUBLE, DOUBLE PRECISION
	  "D\\(ATE\\(TIME\\|\\)\\|ECIMAL\\|OUBLE\\([ \t\n]+PRECISION\\|"
	  "\\)\\)\\|"
	  ;; E - none
	  ;; F - FLOAT[48]?
	  "FLOAT[48]?\\|"
	  ;; G - GENERAL, GUID
	  "G\\(ENERAL\\|UID\\)\\|"
	  ;; H - none
	  ;; I - IEEEDOUBLE, IEEESINGLE, INT, INTEGER[124]?
	  "I\\(EEE\\(DOUBLE\\|SINGLE\\)\\|NT\\(EGER[124]?\\|\\)\\)\\|"
	  ;; JK - none
	  ;; L - LONG, LONGTEXT, LONGBINARY, LOGICAL[1]?
	  "LO\\(GICAL[1]?\\|NG\\(TEXT\\|BINARY\\|\\)\\)\\|"
	  ;; M - MEMO, MONEY
	  "M\\(EMO\\|ONEY\\)\\|"
	  ;; N - NUMBER, NUMERIC
	  "NUM\\(BER\\|ERIC\\)\\|"
	  ;; O - OLEOBJECT
	  "OLEOBJECT\\|"
	  ;; PQ - none
	  ;; R - REAL
	  "REAL\\|"
	  ;; S - SHORT, SINGLE, SMALLINT, STRING
	  "S\\(HORT\\|INGLE\\|MALLINT\\|TRING\\)\\|"
	  ;; T - TEXT, TIME, TIMESTAMP
	  "T\\(EXT\\|IME\\(STAMP\\|\\)\\)\\|"
	  ;; U - none
	  ;; V - VARBINARY, VARCHAR
	  "VAR\\(BINARY\\|CHAR\\)\\|"
	  ;; WX - none
	  ;; Y - YESNO
	  "YESNO"
	  ;; Z - none
  )
  "Regexp that expands to all supported SQL data types.

These are:
  ALPHANUMERIC, AUTOINCREMENT,
  BINARY, BIT (VARYING), BOOLEAN, BYTE,
  CHAR(ACTER) (VARYING), COUNTER, CURRENCY,
  DATE, DATETIME, DECIMAL, DOUBLE, DOUBLE PRECISION,
  FLOAT(4,8), GENERAL, GUID,
  IEEEDOUBLE, IEEESINGLE, INT, INTEGER(1,2,4),
  LONG, LONGTEXT, LONGBINARY, LOGICAL(1), MEMO, MONEY,
  NUMBER, NUMERIC, OLEOBJECT, REAL, SHORT, SINGLE, SMALLINT, STRING,
  TEXT, TIME, TIMESTAMP, VARBINARY, VARCHAR, YESNO
")

(defconst sql-query-keywords
  (concat ""
	  ;; A - ACTION_PROCEDURE, ADD, ALL, ALTER TABLE, AND, ANY, AS, ASC,
	  ;;     ASSERT
	  "A\\(CTION_PROCEDURE\\|DD\\|L\\(L\\|TER[ \t\n]+TABLE\\)\\|N\\(D\\|"
	  "Y\\)\\|S\\(C\\|SERT\\|\\)\\)\\|"
	  ;; B - BETWEEN
	  "BETWEEN\\|"
	  ;; C - CASCADE, CHECK, CHECK OPTION, CLOSE CURSOR, CLUSTER, COLUMN
	  ;;     CONSTRAINT, CONTAINS, CREATE (ASSERTION, DOMAIN,
	  ;;     INDEX, SCHEMA, TABLE, VIEW), CURRENT OF CURSOR
	  "C\\(ASCADE\\|HECK\\( OPTION\\|\\)\\|L\\(OSE[ \t\n]+CURSOR\\|"
	  "USTER\\)\\|O\\(LUMN\\|N\\(STRAINT[S]?\\|NTAINS\\)\\)\\|"
	  "REATE[ \t\n]+\\(ASSERTION\\|DOMAIN\\|INDEX\\|SCHEMA\\|TABLE\\|"
	  "VIEW\\)\\|URRENT[ \t\n]+OF[ \t\n]+CURSOR\\)\\|"
	  ;; D - DECLARE CURSOR, DEFAULT, DEFINE TRIGGER, DELETE, DESC,
	  ;;     DISALLOW, DISTINCT(ROW), DROP (INDEX, SCHEMA, TABLE, VIEW)
	  "D\\(E\\(CLARE[ \t\n]+CURSOR\\|FAULT\\|INE[ \t\n]+TRIGGER\\|LETE\\|"
	  "SC\\)\\|IS\\(ALLOW\\|TINCT\\(ROW\\|\\)\\)\\|ROP[ \t\n]+\\(INDEX\\|"
	  "SCHEMA\\|TABLE\\|VIEW\\)\\)\\|"
	  ;; E - EXCEPT, EXECUTE, EXISTS
	  "EX\\(CEPT\\|ECUTE\\|ISTS\\)\\|"
	  ;; F - FETCH, FOR UPDATE OF, FOREIGN KEY, FROM
	  "F\\(ETCH\\|OR\\([ \t\n]+UPDATE OF\\|EIGN[ \t\n]+KEY\\)\\|ROM\\)\\|"
	  ;; G - GRANT, GRANT OPTION, GROUP BY
	  "GR\\(ANT\\([ \t\n]+OPTION\\|\\)\\|OUP[ \t\n]+BY\\)\\|"
	  ;; H - HAVING
	  "HAVING\\|"
	  ;; I - IGNORE, IN, INFORMATION_SCHEMA, INSERT, INTERSECT, INTO, 
	  ;;     IS [NOT] NULL
	  "I\\(GNORE\\|N\\(FORMATION_SCHEMA\\|SERT\\|TERSECT\\|TO\\|\\)"
	  "\\|S[ \t\n]+\\(NOT[ \t\n]+\\|\\)NULL\\)\\|"
	  ;; J - JOIN (NATURAL -, INNER -, LEFT/RIGHT/FULL OUTER -)
	  "\\(INNER[ \t\n]+\\|NATURAL[ \t\n]+\\|\\(FULL[ \t\n]+\\|"
	  "LEFT[ \t\n]+\\|RIGHT[ \t\n]+\\)OUTER \\|\\)JOIN\\|"
	  ;; K - none
	  ""
	  ;; L - LIKE
	  "LIKE\\|"
	  ;; M - MINUS
	  "MINUS\\|"
	  ;; N - NOT EXISTS, NOT NULL, NULL
	  "N\\(OT[ \t\n]+\\(EXISTS\\|NULL\\)\\|ULL\\)\\|"
	  ;; O - OPEN CURSOR, OR, ORDER BY
	  "O\\(PEN[ \t\n]+CURSOR\\|R\\(DER[ \t\n]+BY\\|\\)\\)\\|"
	  ;; P - PREPARE, PRIMARY KEY
	  "PR\\(EPARE\\|IMARY[ \t\n]+KEY\\)\\|"
	  ;; Q - none
	  ""
	  ;; R - REFERENCES, RESTRICT, REVOKE
	  "RE\\(FERENCES\\|STRICT\\|VOKE\\)\\|"
	  ;; S - SELECT, SET, SET (DEFAULT, NULL), SOME
	  "S\\(E\\(LECT\\|T\\([ \t\n]+DEFAULT\\|[ \t\n]+NULL\\)\\)\\|OME\\)\\|"
	  ;; T - none
	  ""
	  ;; U - UNION, UNIQUE, UPDATE
	  "U\\(NI\\(ON\\|QUE\\)\\|PDATE\\)\\|"
	  ;; V - VALUES
	  "VALUES\\|"
	  ;; W - WHERE CURRENT OF, WHERE, WITH CHECK OPTION
	  "W\\(HERE\\([ \t\n]+CURRENT[ \t\n]+OF\\|\\)\\|"
	  "ITH[ \t\n]+CHECK[ \t\n]+OPTION\\)"
	  ;; XYZ - none
	  ""
  )
  "Regexp that expands to all supported SQL keywords.

These are:
  A - ACTION_PROCEDURE, ADD, ALL, ALTER TABLE, AND, ANY, AS, ASC,
      ASSERT
  B - BETWEEN
  C - CASCADE, CHECK, CHECK OPTION, CLOSE CURSOR, CLUSTER, COLUMN
      CONSTRAINT, CONTAINS, CREATE (ASSERTION, DOMAIN,
      INDEX, SCHEMA, TABLE, VIEW), CURRENT OF CURSOR
  D - DECLARE CURSOR, DEFAULT, DEFINE TRIGGER, DELETE, DESC,
      DISALLOW, DISTINCT(ROW), DROP (INDEX, SCHEMA, TABLE, VIEW)
  E - EXCEPT, EXECUTE, EXISTS
  F - FETCH, FOR UPDATE OF, FOREIGN KEY, FROM
  G - GRANT, GRANT OPTION, GROUP BY
  H - HAVING
  I - IGNORE, IN, INFORMATION_SCHEMA, INSERT, INTERSECT, INTO, 
      IS [NOT] NULL
  J - JOIN (NATURAL -, INNER -, LEFT/RIGHT/FULL OUTER -)
  K - none
  L - LIKE
  M - MINUS
  N - NOT EXISTS, NOT NULL, NULL
  O - OPEN CURSOR, OR, ORDER BY
  P - PREPARE, PRIMARY KEY
  Q - none
  R - REFERENCES, RESTRICT, REVOKE
  S - SELECT, SET, SET (DEFAULT, NULL), SOME
  T - none
  U - UNION, UNIQUE, UPDATE
  V - VALUES
  W - WHERE CURRENT OF, WHERE, WITH CHECK OPTION
  XYZ - none
")

(defconst sql-comments
  "\\(--\\|rem \\)"
  "Regexp that expands to all comment leaders recognized by SQL.
A comment goes until the end of a line.
By default, this expands to '--' and 'rem '.
")

(defconst sql-font-lock-keywords
  (list
   ;; comments
   (cons (concat sql-comments ".*") 'font-lock-comment-face)
   ;; some special characters
   '("[=<>();.,%\*]" . font-lock-function-name-face)
   ;; the keywords
   (cons (concat "\\<\\(" sql-query-keywords "\\)\\>") 'font-lock-keyword-face)
   ;; the types
   (cons (concat "\\<\\(" sql-query-data-types "\\)\\>") 'font-lock-type-face)
   ;; the functions
   (cons (concat "\\<\\(" sql-query-functions "\\)\\>") 
	 'font-lock-function-name-face)
  )
)

(defvar sql-mode-map nil
  "The keymap and menus used in SQL Mode.")
(if sql-mode-map ()
  (setq sql-mode-map (make-sparse-keymap))
  
  (define-key sql-mode-map "\C-c\C-k" 'sql-set-keyword-case)
  (define-key sql-mode-map "\C-c\C-u" 'sql-upcase-keywords)
  (define-key sql-mode-map "\C-c\C-d" 'sql-downcase-keywords)

  (define-key sql-mode-map [menu-bar] (make-sparse-keymap))
  (define-key sql-mode-map [menu-bar sql-mode] 
    (cons "SQL" (make-sparse-keymap "SQL")))
  (define-key sql-mode-map [menu-bar sql-mode keyword-case] 
    '("Set keyword case" . sql-set-keyword-case))
  (define-key sql-mode-map [menu-bar sql-mode keywords-upcase] 
    '("Upcase keywords" . sql-upcase-keywords))
  (define-key sql-mode-map [menu-bar sql-mode keywords-downcase] 
    '("Downcase keywords" . sql-downcase-keywords))
)

;;;###autoload
(defun sql-mode ()
  "Major mode for editing SQL queries.
The hook variable `sql-mode-hook' is run at startup.
Nothing much is done yet, besides fontification.

Key Bindings for SQL Mode:
\\{sql-mode-map}

Variables:
`sql-keywords-anycase'       Default behaviour for keyword fontification.
                              (case-(in)sensitive)

Functions:
`sql-set-keywords-case'      Toggles behaviour for keyword fontification.
                              (also sets `sql-keywords-anycase')
"
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-keywords-case-fold-search)
  (use-local-map sql-mode-map)

  (setq major-mode 'sql-mode mode-name "SQL")
  (setq font-lock-defaults '(sql-font-lock-keywords nil sql-keywords-anycase))

  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-column)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-multi-line)

  (setq comment-start "-- "
 	comment-end   ""
	comment-column 32
 	comment-multi-line nil)

  (run-hooks 'sql-mode-hook)
)

(defun sql-set-keyword-case ()
  "Toggle between uppercase-only keywords and any-case keywords."
  (setq font-lock-keywords-case-fold-search
	(setq sql-keywords-anycase (not sql-keywords-anycase)))
  (font-lock-fontify-buffer)
)

(defun sql-upcase-keywords()
"Converts all SQL keywords, data types and functions to uppercase.
"
  (interactive)
  (let ((old-case-fold case-fold-search))
    (setq case-fold-search t)
    (save-excursion
      (message "This may take a while... (upcasing functions)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward
		       (concat "\\<\\(" sql-query-functions "\\)\\>") nil t) 
		      nil))
	(replace-match (upcase (match-string 0)) t))
      (message "This may take a while... (upcasing data types)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward
		       (concat "\\<\\(" sql-query-data-types "\\)\\>") nil t) 
		      nil))
	(replace-match (upcase (match-string 0)) t))
      (message "This may take a while... (upcasing keywords)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward 
		       (concat "\\<\\(" sql-query-keywords "\\)\\>") nil t) 
		      nil))
	(replace-match (upcase (match-string 0)) t))
    )
    (setq case-fold-search old-case-fold)
  )
  (message "Done!")
)

(defun sql-downcase-keywords()
"Converts all SQL keywords, data types and functions to lowercase.
"
  (interactive)
  (let ((old-case-fold case-fold-search))
    (setq case-fold-search t)
    (save-excursion
      (message "This may take a while... (downcasing functions)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward
		       (concat "\\<\\(" sql-query-functions "\\)\\>") nil t) 
		      nil))
	(replace-match (downcase (match-string 0)) t))
      (message "This may take a while... (downcasing data types)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward
		       (concat "\\<\\(" sql-query-data-types "\\)\\>") nil t) 
		      nil))
	(replace-match (downcase (match-string 0)) t))
      (message "This may take a while... (downcasing keywords)")
      (beginning-of-buffer-nomark)
      (while (not (eq (re-search-forward
		       (concat "\\<\\(" sql-query-keywords "\\)\\>") nil t) 
		      nil))
	(replace-match (downcase (match-string 0)) t))
    )
    (setq case-fold-search old-case-fold)
  )
  (message "Done!")
)

(provide 'sql-mode)
