D4 mode

[Leandro Guimaraes Faria C. Dutra]

        I've done a quick hack on the static parts of SQL mode for Alphora
Dataphor D4, an almost truly relational data language (unlike SQL, it
actually has a claim to quasi-compliance with the relational model).

        D4 ain't free software (I am trying to indoctrinate its owner),
but I've found this mode quite useful anyhow.

        Should I sign any papers?

;;; d4.el -- mode for Alphora Dataphor's D4 data language.

;; Copyright (C) 1998, 1999, 2000, 2001  Free Software Foundation, Inc.

;; Author: Alex Schroeder <address@hidden>
;; Maintainer: Leandro Guimarães Faria Corcete DUTRA
<address@hidden>
;; Version: 1
;; Keywords: comm languages processes
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?D4Mode

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Please send bug reports and bug fixes to the maintainer (above).

;; This file provides a d4-mode.  My goals was a simple mode providing
;; syntactic hilighting, "simple" in this context means easy to use,
;; easy to maintain and little or no bells and whistles.

;; If anybody feels like extending this mode, take a look at the above
;; mentioned modes and write a d4x-mode on top of this one.  If this
;; proves to be difficult, please suggest changes that will facilitate
;; your plans.

;; d4-mode can be used to keep editing D4 statements.

;; For documentation on the functionality provided by comint mode, and
;; the hooks available for customizing it, see the file `comint.el'.

;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and
;; `imenu-add-menubar-index'.

;;; Requirements for Emacs 19.34:

;; If you are using Emacs 19.34, you will have to get and install
;; the file regexp-opt.el
;;
<URL:ftp://ftp.ifi.uio.no/pub/emacs/emacs-20.3/lisp/emacs-lisp/regexp-opt.el>
;; and the custom package
;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.

;;; Bugs:

;; ChangeLog available on request.

;;; To Do:

;; Add better hilight support.  Just send in your lists of reserved
;; words, keywords and builtin functions!

;; Add different hilighting levels.

;;; Thanks to all the people who helped me out:

;; Kai Blauberg <address@hidden>
;; <address@hidden>
;; Yair Friedman <address@hidden>
;; Gregor Zych <address@hidden>
;; nino <address@hidden>
;; Berend de Boer <address@hidden>



;;; Code:

(require 'comint)
;; Need the following to allow GNU Emacs 19 to compile the file.
(require 'regexp-opt)
(require 'custom)

;;; Allow customization

(defgroup D4 nil
  "Editing D4 code from within Emacs buffers"
  :version "1"
  :group 'processes)

;; misc customization of d4.el behaviour

;; imenu support for d4-mode.

(defvar d4-imenu-generic-expression
  '(("Tables" "^\\s-*create\\s-+table\\s-+\\(\\w+\\)" 1)
    ("Indexes" "^\\s-*create\\s-+index\\s-+\\(\\w+\\)" 1))
  "Define interesting points in the D4 buffer for `imenu'.

This is used to set `imenu-generic-expression' when D4 mode is
entered.  Subsequent changes to d4-imenu-generic-expression will not
affect existing D4 buffers because imenu-generic-expression is a
local variable.")

;; The usual hooks

(defcustom d4-mode-hook '()
  "*Hook for customizing `d4-mode'."
  :type 'hook
  :group 'D4)



;; Abbreviations -- if you want more of them, define them in your
;; ~/.emacs file.  Abbrevs have to be enabled in your ~/.emacs, too.

(defvar d4-mode-abbrev-table nil
  "Abbrev table used in `d4-mode'.")
(if d4-mode-abbrev-table
    ()
  (let ((wrapper))
    (define-abbrev-table 'd4-mode-abbrev-table ())
    (define-abbrev d4-mode-abbrev-table  "ins" "insert" nil)
    (define-abbrev d4-mode-abbrev-table  "upd" "update" nil)
    (define-abbrev d4-mode-abbrev-table  "del" "delete" nil)
    (define-abbrev d4-mode-abbrev-table  "sel" "select" nil)))

;; Syntax Table

(defvar d4-mode-syntax-table
  (let ((table (make-syntax-table)))
    ;; C-style comments /**/ (see elisp manual "Syntax Flags"))
    (modify-syntax-entry ?/ ". 14" table)
    (modify-syntax-entry ?* ". 23" table)
    ;; double-dash starts comment
    (if (string-match "XEmacs\\|Lucid" emacs-version)
        (modify-syntax-entry ?- ". 56" table)
      (modify-syntax-entry ?- ". 12b" table))
    ;; newline and formfeed end coments
    (modify-syntax-entry ?\n "> b" table)
    (modify-syntax-entry ?\f "> b" table)
    ;; single quotes (') quotes delimit strings
    (modify-syntax-entry ?' "\"" table)
    table)
  "Syntax table used in `d4-mode'.")

;; Font lock support

(defvar d4-mode-font-lock-keywords nil
  "D4 keywords used by font-lock.

This variable is used by `d4-mode'.  The
regular expressions are created during compilation by calling the
function `regexp-opt'.  Therefore, take a look at the source before
you define your own d4-mode-font-lock-keywords.  You may want to
add functions and keywords.")
(if d4-mode-font-lock-keywords
    ()
  (let ((d4-keywords (eval-when-compile
                         (concat "\\b"
                                 (regexp-opt '(
"authorization" "avg" "begin" "close" "commit" "continue" "count"
"declare" "double" "end" "escape" "exec" "fetch" "foreign" "found"
"go" "goto" "indicator" "key" "language" "max" "min" "module"
"numeric" "open" "precision" "primary" "procedure" "references"
"rollback" "schema" "section" "some" "d4code" "d4error" "static" "sum"
"work") t)
"\\b")))
        (d4-reserved-words (eval-when-compile
                               (concat "\\b"
                                       (regexp-opt '(
"all" "alter" "and" "any" "as" "asc" "between" "by" "check"
"constraint" "create" "current" "default" "delete" "desc" "distinct"
"exists" "float" "for" "from" "grant" "group" "having" "in" "insert"
"into" "is" "like" "not" "null" "of" "on" "option" "or" "order"
"privileges" "public" "select" "set" "table" "tags" "to" "type"
"union" "unique" "update" "user" "values" "view" "where" "with") t)
"\\b")))
        (d4-builtin-functions (eval-when-compile
                        (concat "\\b"
                                (regexp-opt '(
;; Misc D4 builtin functions
"abs" "add_months" "ascii" "avg" "Catalog.Comment" "ceil"
"chartorowid" "chr" "concat" "convert" "cos" "cosh" "count" "currval"
"DAE.SimpleMessage" "dump" "exp" "floor" "glb" "greatest" "greatest_lb"
"hextoraw" "initcap" "instr" "instrb" "last_day" "least" "least_ub"
"lengthvalid" "lengthb" "ln" "log" "lower" "lpad" "ltrim" "lub" "max"
"min" "mod" "months_between" "new_time" "next_day" "nextval"
"nls_initcap" "nls_lower" "nls_upper" "nlssort" "nvl" "power"
"rawtohex" "ReadValue" "replace" "round" "rowidtochar" "rpad" "rtrim"
"sign" "sin"
"sinh" "soundex" "sqlcode" "sqlerrm" "sqrt" "stddev" "sum" "substr"
"Storage.Length" "System.Length" "tan" "tanh" "to_char" "to_date"
"to_label"
"to_multi_byte" "to_number" "to_single_byte" "translate" "trim"
"trunc" "uid" "upper" "userenv" "variance" "vsize") t) "\\b")))
        (d4-types (eval-when-compile
                      (concat "\\b"
                              (regexp-opt '(
;; Keywords that look like types
"character" "cursor" "dec" "int" "real" "System.String" "comment"
;; Reserved Word that look like types
"char" "integer" "smallint" ) t) "\\b"))))
    (setq d4-mode-font-lock-keywords
          (list (cons d4-keywords 'font-lock-function-name-face)
                (cons d4-reserved-words 'font-lock-keyword-face)
                (cons d4-types 'font-lock-type-face)
                (cons d4-builtin-functions 'font-lock-builtin-face)))))

(defvar d4-mode-font-lock-keywords d4-mode-font-lock-keywords
  "D4 keywords used by font-lock.

This variable defaults to `d4-mode-font-lock-keywords'.  This is
used for the default `font-lock-defaults' value in `d4-mode'.  This
can be changed by some entry functions to provide more hilighting.")



;;; Functions to switch highlighting

(defun d4-highlight-keywords ()
  "Highlight D4 keywords.
Basically, this just sets `font-lock-keywords' appropriately."
  (interactive)
  (setq font-lock-keywords d4-mode-font-lock-keywords)
  (font-lock-fontify-buffer))



;;; Compatibility functions

(if (not (fboundp 'comint-line-beginning-position))
    ;; comint-line-beginning-position is defined in Emacs 21
    (defun comint-line-beginning-position ()
      "Returns the buffer position of the beginning of the line, after any
prompt.
The prompt is assumed to be any text at the beginning of the line matching
the regular expression `comint-prompt-regexp', a buffer local variable."
      (save-excursion (comint-bol nil) (point))))



;;; Small functions

(defun d4-accumulate-and-indent ()
  "Continue D4 statement on the next line."
  (interactive)
  (if (fboundp 'comint-accumulate)
      (comint-accumulate)
    (newline))
  (indent-according-to-mode))

;;;###autoload
(defun d4-help ()
  "Show short help for the D4 modes.

If you have a D4 statement or if you are writing a procedure, you can
do this in a separate buffer.  Put the new buffer in `d4-mode' by
calling \\[d4-mode].  The name of this buffer can be anything.  The
name of the major mode is D4."
  (interactive)
  (describe-function 'd4-help))


(defun d4-copy-column ()
  "Copy current column to the end of buffer.
Inserts SELECT or commas if appropriate."
  (interactive)
  (let ((column))
    (save-excursion
      (setq column (buffer-substring
                  (progn (forward-char 1) (backward-sexp 1) (point))
                  (progn (forward-sexp 1) (point))))
      (goto-char (point-max))
      (let ((bol (comint-line-beginning-position)))
        (cond
         ;; if empty command line, insert SELECT
         ((= bol (point))
          (insert "SELECT "))
         ;; else if appending to INTO .* (, SELECT or ORDER BY, insert a
comma
         ((save-excursion
            (re-search-backward
"\\b\\(\\(into\\s-+\\S-+\\s-+(\\)\\|select\\|order by\\) .+"
                                bol t))
          (insert ", "))
         ;; else insert a space
         (t
          (if (eq (preceding-char) ? )
              nil
            (insert " ")))))
      ;; in any case, insert the column
      (insert column)
      (message "%s" column))))



;;; D4 mode

;;;###autoload
(defun d4-mode ()
  "Major mode to edit D4.

Customization: Entry to this mode runs the `d4-mode-hook'."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'd4-mode)
  (setq mode-name "D4")
  (if d4-mode-menu
      (easy-menu-add d4-mode-menu)); XEmacs
  (set-syntax-table d4-mode-syntax-table)
  (make-local-variable 'font-lock-defaults)
  ;; `_' and `.' are considered part of words.
  (setq font-lock-defaults '(d4-mode-font-lock-keywords
                             nil t ((?_ . "w") (?. . "w"))))
  (make-local-variable 'comment-start)
  (setq comment-start "--")
  ;; Add imenu support for d4-mode.  Note that imenu-generic-expression
  ;; is buffer-local, so we don't need a local-variable for it.  D4 is
  ;; case-insensitive, that's why we have to set imenu-case-fold-search.
  ;; imenu-syntax-alist makes sure that `_' is considered part of object
  ;; names.
  (setq imenu-generic-expression d4-imenu-generic-expression
        imenu-case-fold-search t
        imenu-syntax-alist '(("_" . "w")))
  ;; Work on paragraphs that contain indented lines.
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-start)
  (setq paragraph-separate "[\f]*$"
        paragraph-start "[\n\f]")
  ;; Abbrevs
  (setq local-abbrev-table d4-mode-abbrev-table)
  (setq abbrev-all-caps 1)
  ;; Run hook
  (run-hooks 'd4-mode-hook))

(provide 'd4)

;;; d4.el ends here


--
Leandro Guimarães Faria Corcete DUTRA
Administrador de Bases de Dados      +55 (11) 4390 5310
Toyota do Brasil Ltda              address@hidden
São Bernardo da Borda do Campo, SP               BRASIL





This message (including any attachments) is confidential and may be privileged 
and intended solely for the use of the person/entity to whom it is addressed. 
If you have received it by mistake please notify the sender by returning via 
e-mail as well as delete this message from your system. Any unauthorized use or 
dissemination of this message in whole or in part is prohibited. Please note 
that e-mails are susceptible to change. TOYOTA DO BRASIL LTDA (including its 
group companies) shall not be liable for the improper or incomplete 
transmission of the information contained in this communication, neither for 
personal, nonbusiness related information nor opinion sent through this email 
or even for any delay in its receipt or damage to your system. TOYOTA DO BRASIL 
LTDA (or its group companies) does not guarantee that the integrity of this 
communication has been kept nor that this communication is free of viruses, 
interceptions or interference.