The code files. Taken from assembla working copy

enode-lisp/enode-oracle.el

@@ -0,0 +1,765 @@
+
+(defun enode-oracle-connect (conn-user conn-pass conn-connection conn-prompt)
+  "A function to connect to an oracle database."
+  ;; Create a temporary buffer and go to it.
+  (with-temp-buffer
+    ;; Set it to be an SQL commands buffer.
+    (sql-mode)
+    ;; Put in the connection and sqlprompt modification commands, and
+    ;; set the serverout on.
+    (insert
+     (format "\nconnect %s/%s@%s\nset serverout on\nset sqlprompt \"%s> \"\n"
+             conn-user
+             conn-pass
+             conn-connection
+             conn-prompt))
+    ;; Send the temp buffer to the *SQL* process buffer.
+    (sql-send-region (point-min) (point-max))
+    )
+  )
+
+(defun enode-oracle-disconnect ()
+  "A function to close an oracle database connection."
+  (with-temp-buffer
+    (sql-mode)
+    (insert (format "\ndisconnect\n"))
+    (sql-send-region (point-min) (point-max))
+    (enode-oracle-sqlplus-set-prompt "NOP")
+    )
+  )
+
+(defun enode-oracle-start-sql-engine ()
+  "A function to set up the SQL engine for connecting to an Oracle database.
+Currently, only SQL*Plus is supported."
+  (call-interactively 'sql-oracle)
+  ;; Set the prompt regexps properly
+  (save-excursion
+    (set-buffer "*SQL*")
+    (setq comint-prompt-regexp "^[0-9A-Za-z]\\{3\\}> ")
+    (setq sql-prompt-regexp "^[0-9A-Za-z]\\{3\\}> ")
+    ;; (enode-oracle-sqlplus-set-timing "on")
+    )
+  )
+
+(defun enode-oracle-stop-sql-engine ()
+  "A function to close the engine connecting to the oracle database.
+Currently, only SQL*Plus is supported."
+  ;; Kludge to get around the fact that redirecting output from exit
+  ;; doesn't really work.
+  (comint-send-string (get-buffer-process sql-buffer) (format "exit\n"))
+  (sleep-for 3)
+;;   (with-temp-buffer
+;;     (enode-oracle-run-sql-command "exit"
+;;                                   (current-buffer)
+;;                                   sql-buffer
+;;                                   t)
+;;     )
+  )
+
+(defun enode-oracle-list-users (user-list-buffer)
+  "A function to list the users in an Oracle database."
+  (let ((user-list-command
+         (format "select username from all_users order by username;"))
+        )
+    ;; Run the SQL command.
+    (enode-oracle-run-sql-command user-list-command
+                                  user-list-buffer
+                                  sql-buffer)
+    )
+  )
+
+(defun enode-oracle-desc (object-name desc-buffer)
+  "A function to run the SQL DESCRIBE command for an object and to present
+the output."
+  (let ((desc-command (format "desc %s" object-name)))
+    (enode-oracle-run-sql-command desc-command
+                                  desc-buffer
+                                  sql-buffer)
+    )
+  )
+
+(defun enode-oracle-list-objects (object-list-buffer dbuser
+                                                     &optional object-type
+                                                     invalid-flag
+                                                     filter-string)
+  "A function to get up a list of objects in an oracle database."
+  (let ((object-list-command
+         (format "%s%s%s;"
+                 "select object_name, object_type, status "
+                 (format "from   %s " (if dbuser "all_objects" "user_objects"))
+                 (let (have-where
+                       where-clause)
+                   (if dbuser
+                       (if have-where
+                           (setq where-clause
+                                 (concat where-clause
+                                         " "
+                                         (format "and owner = '%s' " dbuser)
+                                         )
+                                 )
+                         (setq where-clause
+                               (format "where owner = '%s' " dbuser))
+                         (setq have-where t)
+                         )
+                     )
+                   (if object-type
+                       (if have-where
+                           (setq where-clause
+                                 (concat where-clause
+                                         " "
+                                         (format "and object_type = '%s' "
+                                                 object-type)
+                                         )
+                                 )
+                         (setq where-clause
+                               (format "where object_type = '%s' "
+                                       object-type))
+                         (setq have-where t)
+                         )
+                     )
+                   (if invalid-flag
+                       (if have-where
+                           (setq where-clause
+                                 (concat where-clause
+                                         " and status = 'INVALID' "
+                                         )
+                                 )
+                         (setq where-clause
+                               "where status = 'INVALID' ")
+                         (setq have-where t)
+                         )
+                     )
+                   (if filter-string
+                       (if have-where
+                           (setq where-clause
+                                 (concat where-clause
+                                         " and object_name like '%"
+                                         filter-string
+                                         "%' "
+                                         )
+                                 )
+                         (setq where-clause
+                               (concat "where object_name like '%"
+                                       filter-string
+                                       "%' ")
+                               )
+                         (setq have-where t)
+                         )
+                     )
+                   where-clause
+                   )
+                 )
+         )
+        )
+    (enode-oracle-run-sql-command object-list-command
+                                  object-list-buffer
+                                  sql-buffer)
+    )
+  )
+
+(defun enode-oracle-list-object-types (object-type-list-buffer
+                                       &optional dbuser)
+  "A function to show the list of object types in an oracle database broken
+down by user. If DBUSER is non-nil, list only for that user."
+  (let ((object-type-list-command
+         (format "%s%s%s%s%s;"
+                 "select owner, object_type, count(*) "
+                 "from   all_objects "
+                 (if dbuser (format "where  owner = '%s' " (upcase dbuser)) "")
+                 "group by owner, object_type "
+                 "order by owner, object_type "
+                 ))
+        )
+    ;; Run the SQL command.
+    (enode-oracle-run-sql-command object-type-list-command
+                                  object-type-list-buffer
+                                  sql-buffer)
+    )
+  )
+
+(defun enode-oracle-run-sql-command (sql-command output-buffer sql-buffer
+                                                 &optional asynchronous)
+  "A function to run an SQL command in a synchronous manner. If ASYNCHRONOUS is non-nil, it's run, you guessed it, asynchronously."
+  ;; Run it as though it's from where we're calling it.
+  (save-excursion
+    ;; Run the command, not echoing the output.
+    (comint-redirect-send-command-to-process sql-command
+                                             output-buffer
+                                             sql-buffer
+                                             nil)
+    ;; If we don't want to pretend it's synchronous, don't
+    (if (not asynchronous)
+        (enode-wait-for-command)
+      )
+    )
+  )
+
+(defun enode-oracle-pls-code-max-length (pls-name pls-type &optional pls-owner)
+  "A function to return the length of the longest line in a block of
+stored PL/SQL code."
+  ;; Do all this in a temporary buffer
+  (with-temp-buffer
+          ;; Get the buffer name
+    (let ((my-buffer (current-buffer))
+          ;; Determine the code to run
+          (plsql-code-line-length-command
+           (format "%s%s%s%s%s;"
+                   "select max ( length ( text ) ) "
+                   (format "from   %s " (if pls-owner "all_source"
+                                          "user_source"))
+                   (format "where  name = '%s' " (upcase pls-name))
+                   (format "and    type = '%s' " (upcase pls-type))
+                   (if pls-owner (format "and    owner = '%s' "
+                                         (upcase pls-owner))
+                     ""))))
+      ;; Run the command synchronously
+      (enode-oracle-run-sql-command plsql-code-line-length-command
+                                    my-buffer
+                                    sql-buffer)
+      ;; Go to the buffer
+      (set-buffer my-buffer)
+      ;; Go to the end
+      (goto-char (point-max))
+      ;; Look back for the returned value
+      (re-search-backward "^[ 	]+\\([0-9]+\\)[ 	]*$")
+      ;; and return it.
+      (match-string 1)
+      )
+    )
+  )
+
+(defun enode-oracle-get-pls-code (pls-name pls-type &optional pls-owner)
+  "A function to present a block of PL/SQL code. Really should be called from
+a wrapper. PLS-NAME is the name of the PL/SQL block, PLS-TYPE is its type
+function, package, etc. and PLS-OWNER is the block's owner. If
+PLS-OWNER is NIL, assume the current user."
+        ;; Get the length of the longest line of the code block
+  (let ((block-line-length
+         (enode-oracle-pls-code-max-length pls-name pls-type pls-owner))
+        ;; Determine the current SQL*Plus state
+        (current-sqlplus-state (enode-oracle-sqlplus-get-state))
+        ;; Get a buffer for the code.
+        (code-buffer (enode-oracle-plsql-code-buffer pls-name pls-owner))
+        )
+    ;; Set the SQL*Plus state to something that's suitable for this
+    ;; '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL
+    ;;   LONGCHUNKSIZE TERMOUT)
+    (enode-oracle-sqlplus-set-state (list block-line-length 0 nil "off"
+                                          "off" nil)
+                                    )
+          ;; Create the SQL code to get the PL/SQL code.
+    (let ((plsql-code-command
+           (format "%s%s%s%s%s%s;"
+                   "select text "
+                   (format "from   %s " (if pls-owner "all_source"
+                                          "user_source"))
+                   (format "where  name = '%s' " (upcase pls-name))
+                   (format "and    type = '%s' " (upcase pls-type))
+                   (if pls-owner (format "and    owner = '%s' "
+                                         (upcase pls-owner))
+                     "")
+                   "order by line")))
+      ;; Run the command.
+      (enode-oracle-run-sql-command plsql-code-command code-buffer sql-buffer)
+      )
+    ;; Restore the state
+    (enode-oracle-sqlplus-set-state current-sqlplus-state)
+    (save-excursion
+      ;; Go to the buffer with the code.
+      (set-buffer code-buffer)
+      ;; It's PL/SQL code, set the mode.
+      (pls-mode)
+      )
+    (display-buffer code-buffer)
+    )
+  )
+
+(defun enode-oracle-timing-on ()
+  "Turn on timing reports for SQL*Plus commands"
+  (interactive)
+  (enode-oracle-sqlplus-set-timing "on")
+  )
+
+(defun enode-oracle-get-pls-package-code (proc-name &optional proc-owner)
+  "A function to return the code of a PL/SQL package spec."
+  (interactive (list (read-from-minibuffer "Package Name: ")))
+  (enode-oracle-get-pls-code proc-name "package" proc-owner))
+
+(defun enode-oracle-get-pls-package-body-code (proc-name &optional proc-owner)
+  "A function to return the code of a PL/SQL package body."
+  (interactive (list (read-from-minibuffer "Package Name: ")))
+  (enode-oracle-get-pls-code proc-name "package body" proc-owner))
+
+(defun enode-oracle-get-pls-procedure-code (proc-name &optional proc-owner)
+  "A function to return the code of a PL/SQL procedure."
+  (interactive (list (read-from-minibuffer "Procedure Name: ")))
+  (enode-oracle-get-pls-code proc-name "procedure" proc-owner))
+
+(defun enode-oracle-get-pls-function-code (func-name &optional func-owner)
+  "A function to return the code of a PL/SQL function."
+  (interactive (list (read-from-minibuffer "Function Name: ")))
+  (enode-oracle-get-pls-code func-name "function" func-owner))
+
+(defun enode-oracle-sqlplus-get-state ()
+  "A function to determine the current state of the SQL*Plus interface. It
+returns a list in the following format '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL LONGCHUNKSIZE TERMOUT)."
+        ;; Get the settings.
+  (let ((current-linesize (enode-oracle-sqlplus-get-linesize))
+        (current-pagesize (enode-oracle-sqlplus-get-pagesize))
+        (current-timing (enode-oracle-sqlplus-get-timing))
+        (current-heading (enode-oracle-sqlplus-get-heading))
+        (current-feedback (enode-oracle-sqlplus-get-feedback))
+        (current-long (enode-oracle-sqlplus-get-long))
+        (current-trimout (enode-oracle-sqlplus-get-trimout))
+        (current-trimspool (enode-oracle-sqlplus-get-trimspool))
+        (current-longchunksize (enode-oracle-sqlplus-get-longchunksize))
+        (current-termout (enode-oracle-sqlplus-get-termout))
+        )
+    ;; Return the settings as a list.
+    (list current-linesize current-pagesize current-timing current-heading
+          current-feedback current-long current-trimout current-trimspool
+          current-longchunksize current-termout)
+    )
+  )
+
+(defun enode-oracle-sqlplus-set-state (sqlplus-state)
+  "A function to put the current SQL*Plus interface into a certain statd. It
+takes a list in the following format '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL LONGCHUNKSIZE TERMOUT).
+If any of this is NIL, it's not touched"
+        ;; Determine the settings
+  (let ((new-linesize (nth 0 sqlplus-state))
+        (new-pagesize (nth 1 sqlplus-state))
+        (new-timing (nth 2 sqlplus-state))
+        (new-heading (nth 3 sqlplus-state))
+        (new-feedback (nth 4 sqlplus-state))
+        (new-long (nth 5 sqlplus-state))
+        (new-trimout (nth 6 sqlplus-state))
+        (new-trimspool (nth 7 sqlplus-state))
+        (new-longchunksize (nth 8 sqlplus-state))
+        (new-termout (nth 9 sqlplus-state))
+        )
+    ;; For each of the settings that are specified in the parameter,
+    ;; set it.
+    (if new-linesize (enode-oracle-sqlplus-set-linesize new-linesize))
+    (if new-pagesize (enode-oracle-sqlplus-set-pagesize new-pagesize))
+    (if new-timing (enode-oracle-sqlplus-set-timing new-timing))
+    (if new-heading (enode-oracle-sqlplus-set-heading new-heading))
+    (if new-feedback (enode-oracle-sqlplus-set-feedback new-feedback))
+    (if new-long (enode-oracle-sqlplus-set-long new-long))
+    (if new-trimout (enode-oracle-sqlplus-set-trimout new-trimout))
+    (if new-trimspool (enode-oracle-sqlplus-set-trimspool new-trimspool))
+    (if new-longchunksize
+        (enode-oracle-sqlplus-set-longchunksize new-longchunksize))
+    (if new-termout (enode-oracle-sqlplus-set-termout new-termout))
+    )
+  )
+
+(defun enode-oracle-plsql-code-buffer
+  (&optional pls-block-name pls-block-owner)
+  "A function to return a buffer to contain the code of a PL/SQL object. The
+name of the buffer encorporates the name of the block if not nil"
+  (enode-code-buffer "plsql" pls-block-name pls-block-owner)
+  )
+
+(defun enode-oracle-view-code-buffer
+  (&optional view-name view-owner)
+  "A function to return a buffer to contain the code of a view. The
+name of the buffer encorporates the name of the block if not nil"
+  (enode-code-buffer "view" view-name view-owner)
+  )
+
+(defun enode-oracle-view-length (view-name &optional view-owner)
+  "A function to return the length of the code making up the definition of
+a view."
+  ;; Do all this in a temporary buffer
+  (with-temp-buffer
+          ;; What buffer?
+    (let ((my-buffer (current-buffer))
+          ;; Create the SQL command to determine the value
+          (view-code-length-command
+           (format "%s%s%s%s;"
+                   "select text_length "
+                   (format "from   %s " (if view-owner "all_views"
+                                          "user_views"))
+                   (format "where  view_name = '%s' " (upcase view-name))
+                   (if view-owner (format "and    owner = '%s' "
+                                          (upcase view-owner))
+                     ""))))
+      ;; Run the command.
+      (enode-oracle-run-sql-command view-code-length-command
+                                    my-buffer
+                                    sql-buffer)
+      ;; Go to the output buffer
+      (set-buffer my-buffer)
+      ;; Go to the end.
+      (goto-char (point-max))
+      ;; Look for the output
+      (re-search-backward "^[ 	]+\\([0-9]+\\)[ 	]*$")
+      ;; Return it
+      (match-string 1)
+      )
+    )
+  )
+
+(defun enode-oracle-get-view-code (view-name &optional view-owner)
+  "A function to present the code that makes up a view."
+  (interactive (list (read-from-minibuffer "View name: ")))
+        ;; Get the current SQL*Plus state
+  (let ((current-sqlplus-state (enode-oracle-sqlplus-get-state))
+        ;; The buffer to send the code to
+        (code-buffer (enode-oracle-view-code-buffer view-name view-owner))
+        )
+    ;; Set the SQL*Plus state to something that is suitable.
+    ;; '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL
+    ;;   LONGCHUNKSIZE TERMOUT)
+    (enode-oracle-sqlplus-set-state (list 2499 0 "off" "off" "off" 5242880 "on"
+                                          "on" 2499 "off"))
+          ;; Create the command to get the code.
+    (let ((view-command
+           ;; select dbms_metadate.get_ddl ( 'VIEW', '<<VIEW_NAME>>' )
+           ;; from dual
+           (format "%s%s%s;"
+                   "select dbms_metadata.get_ddl ( 'VIEW', '"
+                   (upcase view-name)
+                   "' ) from dual"
+                   )))
+      ;; Run the command.
+      (enode-oracle-run-sql-command view-command code-buffer sql-buffer)
+      )
+    ;; Restore the SQL*Plus state.
+    (enode-oracle-sqlplus-set-state current-sqlplus-state)
+    (save-excursion
+      ;; Go to the buffer
+      (set-buffer code-buffer)
+      ;; It's SQL code. Set the mode.
+      (sql-mode)
+      )
+    (display-buffer code-buffer)
+    )
+  )
+
+;;;; Change this to use enode-oracle-run-sql-command
+(defun enode-oracle-sqlplus-get-param (sql-setting-command sql-setting-regexp)
+  "A function to get an SQL*Plus setting. It simply runs SQL-SETTING-COMMAND
+and looks in the output for the first parenthesized expression in
+SQL-SETTING-REGEXP."
+  ;; We don't want to disturb anything, now do we?
+  (save-excursion
+    ;; Get an empty output buffer
+    (let ((output-buffer (enode-temp-output-buffer)))
+      ;; Send the command that was passed to get the setting.
+      (comint-redirect-send-command-to-process
+       sql-setting-command output-buffer sql-buffer nil t)
+      ;; Go to the output buffer
+      (set-buffer output-buffer)
+      ;; Wait a short period for the command to complete
+      (enode-wait-for-command)
+      ;; Go to the last position
+      (goto-char (point-max))
+      ;; Search backwards for the passed regular expression
+      (search-backward-regexp sql-setting-regexp nil t)
+      ;; Return the first parenthesised expression from a matched string.
+      (match-string 1)
+      )
+    )
+  )
+
+(defun enode-oracle-get-sql-prompt ()
+  "A function to get the setting of the SQL*Plus prompt"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show sqlprompt" "sqlprompt \"\\([^\"]*\\)\"$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-prompt (value)
+  "A function to set the 'sqlprompt' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "sqlprompt" (concat "\"" value "> \""))
+  )
+
+(defun enode-oracle-sqlplus-get-linesize ()
+  "A function to get the 'linesize' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show linesize" "linesize \\([0-9]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-linesize (value)
+  "A function to set the 'linesize' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "linesize" value)
+  )
+
+(defun enode-oracle-sqlplus-get-long ()
+  "A function to get the 'long' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show long" "long \\([0-9]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-long (value)
+  "A function to set the 'long' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "long" value)
+  )
+
+(defun enode-oracle-sqlplus-get-longchunksize ()
+  "A function to get the 'longchunksize' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show longchunksize" "longchunksize \\([0-9]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-longchunksize (value)
+  "A function to set the 'longchunksize' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "longchunksize" value)
+  )
+
+(defun enode-oracle-sqlplus-get-pagesize ()
+  "A function to get the 'pagesize' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show pagesize" "^pagesize \\([0-9]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-pagesize (value)
+  "A function to set the 'pagesize' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "pagesize" value)
+  )
+
+(defun enode-oracle-sqlplus-get-heading ()
+  "A function to get the 'heading' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show heading" "^heading \\(O[NF]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-heading (value)
+  "A function to set the 'heading' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "heading" value)
+  )
+
+(defun enode-oracle-sqlplus-get-timing ()
+  "A function to get the 'timing' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show timing" "^timing \\(O[NF]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-timing (value)
+  "A function to set the 'timing' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "timing" value)
+  )
+
+(defun enode-oracle-sqlplus-get-termout ()
+  "A function to get the 'termout' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show termout" "^termout \\(O[NF]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-termout (value)
+  "A function to set the 'termout' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "termout" value)
+  )
+
+(defun enode-oracle-sqlplus-get-trimout ()
+  "A function to get the 'trimout' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show trimout" "^trimout \\(O[NF]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-trimout (value)
+  "A function to set the 'trimout' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "trimout" value)
+  )
+
+(defun enode-oracle-sqlplus-get-trimspool ()
+  "A function to get the 'trimspool' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show trimspool" "^trimspool \\(O[NF]+\\)$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-trimspool (value)
+  "A function to set the 'trimspool' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "trimspool" value)
+  )
+
+(defun enode-oracle-sqlplus-get-feedback ()
+  "A function to get the 'feedback' SQL*Plus setting"
+  (format "%s"
+          (enode-oracle-sqlplus-get-param
+           "show feedback" "^FEEDBACK \\(O[NF]+\\).*$")
+          )
+  )
+
+(defun enode-oracle-sqlplus-set-feedback (value)
+  "A function to set the 'feedback' SQL*Plus parameter to VALUE."
+  (enode-oracle-sqlplus-set-param "feedback" value)
+  )
+
+;; This is useful for main ENODE environment.
+;;;; Is this necessary if we user with-temp-buffer()?
+(defun enode-temp-output-buffer ()
+  "A function to return the temporary output buffer for redirected SQL
+commands. If the buffer already exists, it empties it first.
+Call this function directly if you don't care about the output. Set a variable
+to this function's return value if you want to process it once the command
+has completed."
+  ;; Get the buffer
+  (let ((the-buffer (get-buffer-create " *enode-comint-sql-output*")))
+    ;; Empty it.
+    (enode-clean-buffer the-buffer)
+    ;; Return it
+    the-buffer
+    )
+  )
+
+;; This is useful for main ENODE environment.
+;;;; Is this necessary if we user with-temp-buffer()?
+(defun enode-stage-buffer ()
+  "A function to provide a buffer for staging commands out of."
+  (let ((the-buffer (get-buffer-create " *enode-stage-buffer*")))
+    ;; Empty it
+    (enode-clean-buffer the-buffer)
+    ;; Return it
+    the-buffer
+    )
+  )
+
+;;;; Change this to use enode-oracle-run-sql-command
+(defun enode-oracle-sqlplus-set-param (param value)
+  "A function to set an sqlplus parameter, PARAM, to VALUE."
+  (comint-redirect-send-command-to-process
+   (format "set %s %s\n" param value)
+   (enode-temp-output-buffer)
+   (get-buffer-process sql-buffer)
+   nil
+   t)
+  (enode-wait-for-command)
+  )
+
+(defun enode-oracle-get-table-constraints (owner table)
+  "A function to return a list of tables belonging to OWNER"
+  (let ((the-command
+         (format
+          "select constraint_name from all_constraints where table_name = '%s' and owner = '%s';"
+          table
+          owner
+          )
+         )
+        )
+    (comint-redirect-results-list-from-process
+     (get-buffer-process sql-buffer)
+     the-command
+     "^\\([A-Z0-9_]+\\)$"
+     1)
+    )
+  )
+
+(defun enode-oracle-get-table-indexes (owner table)
+  "A function to return a list of indexes on TABLE belonging to OWNER"
+  (let ((the-command
+         (format
+          "select index_name from all_indexes where table_name = '%s' and owner = '%s';"
+          table
+          owner
+          )
+         )
+        )
+    (comint-redirect-results-list-from-process
+     (get-buffer-process sql-buffer)
+     the-command
+     "^\\([A-Z0-9_]+\\)$"
+     1)
+    )
+  )
+
+(defun enode-oracle-get-triggers (owner table)
+  "A function to return a list of indexes on TABLE belonging to OWNER"
+  (let ((the-command
+         (format
+          "select trigger_name from all_triggers where table_name = '%s' and owner = '%s';"
+          table
+          owner
+          )
+         )
+        )
+    (comint-redirect-results-list-from-process
+     (get-buffer-process sql-buffer)
+     the-command
+     "^\\([A-Z0-9_]+\\)$"
+     1)
+    )
+  )
+
+(defun enode-oracle-get-constraint-columns (owner constraint)
+  "A function to return as a list the names of columns in a constraint
+ordered by the position"
+  (let ((the-command
+         (format
+          "select table_name || '.' || column_name from all_cons_columns where constraint_name = '%s' and owner = '%s' order by position;"
+          constraint
+          owner
+          )
+         )
+        )
+    (comint-redirect-results-list-from-process
+     (get-buffer-process sql-buffer)
+     the-command
+     "^\\([\.A-Z0-9_]+\\)$"
+     1)
+    )
+  )
+
+(defun enode-oracle-get-java-source (owner java-source)
+  "A function to return the source of a stored java program."
+  (let ((the-command
+         (format
+          "select text from all_source where name = '%s' and owner = '%s' and type = 'JAVA SOURCE' order by line;"
+          java-source
+          owner
+          )
+         )
+        )
+    (comint-redirect-send-command-to-process
+     the-command
+     (get-buffer-create "*tester*")
+     (get-buffer-process sql-buffer)
+     nil)
+    )
+  )
+
+(defun enode-oracle-commit (&optional rollback)
+  "A function to commit changes to an oracle database"
+  (let ((output-buffer (enode-temp-output-buffer))
+        response-msg
+        )
+    (comint-redirect-send-command-to-process
+     (if rollback (format "rollback;\n") (format "commit;\n"))
+     output-buffer
+     (get-buffer-process sql-buffer)
+     nil
+     t)
+    (enode-wait-for-command)
+    (save-excursion
+      (set-buffer output-buffer)
+      (goto-char (point-min))
+      (forward-line)
+      (setq response-msg
+            (buffer-substring (point) (save-excursion (end-of-line) (point))))
+      )
+    (message "%s" response-msg)
+    )
+  )
+
+(provide 'enode-oracle)

enode-lisp/pls-extras.el

@@ -0,0 +1,806 @@
+(require 'pls-mode)
+
+(defvar enode-pls-identifier-regexp
+  (format "%s%s"
+          (substring pls-identifier-regexp 0 4)
+          (substring pls-identifier-regexp 7))
+  "Removing the capital letters as this has problems later")
+
+(defvar enode-pls-name-regexp
+  (format "%s%s"
+          (substring pls-name-regexp 0 4)
+          (substring pls-name-regexp 7))
+  "Removing the capital letters as this has problems later")
+
+(defvar enode-pls-white-space-regexp
+  "\\s-+"
+  "White space that can separate two tokens."
+  )
+
+(defvar enode-pls-white-space-newline-regexp
+  (concat "\\(
+\\|\\s-\\)+")
+  ;; \(^J\|\s-\)+
+  "White space that can separate two tokens, including new-lines."
+  )
+
+(defvar enode-pls-white-space-maybe-regexp
+  (concat "\\(\\s-\\)*")
+  "The possibility of white space"
+  )
+
+(defvar enode-pls-white-space-newline-maybe-regexp
+  (replace-regexp-in-string
+   "\+$" "*" enode-pls-white-space-newline-regexp)
+  "The possibility of white space, including newlines"
+  )
+
+(defvar enode-declare-regexp
+  (concat "^" enode-pls-white-space-maybe-regexp
+          "declare" enode-pls-white-space-maybe-regexp )
+  "The DECLARE of an anonymous block"
+  )
+
+(defvar enode-create-regexp
+  (concat "^" enode-pls-white-space-maybe-regexp "create\\("
+          enode-pls-white-space-regexp "or" enode-pls-white-space-regexp
+          "replace\\)*" enode-pls-white-space-regexp)
+  "The CREATE... of a named block"
+  )
+
+(defvar enode-block-type-regexp
+  (concat "\\(function\\|procedure\\|package\\("
+          enode-pls-white-space-regexp "body\\)\\{0,1\\}\\)"
+          enode-pls-white-space-regexp)
+  "The types of named blocks"
+  )
+
+(defvar enode-type-spec-regexp
+  ;; This could be a lot better spec'd
+  (concat "\\(" enode-pls-name-regexp "%type\\|" enode-pls-identifier-regexp "\\)")
+  "The type of an identifier"
+  )
+
+(defvar enode-param-inout-spec-regexp
+  ;; This could be a lot better spec'd
+  (concat "\\(in\\|out\\|in" enode-pls-white-space-regexp "out\\)")
+  "The type of an identifier"
+  )
+
+(defvar enode-param-spec-regexp
+  (concat enode-pls-identifier-regexp
+          enode-pls-white-space-regexp
+          "\\(" enode-param-inout-spec-regexp
+                enode-pls-white-space-maybe-regexp "\\)*"
+          enode-pls-white-space-maybe-regexp
+          enode-type-spec-regexp)
+  "A parameter in a function/procedure/etc."
+  )
+
+(defvar enode-authid-spec-regexp
+  (concat "authid" enode-pls-white-space-regexp
+          "\\(current_user\\|definer\\)"
+          enode-pls-white-space-newline-maybe-regexp)
+  )
+
+(defvar enode-decl-return-regexp
+  (concat "return" enode-pls-white-space-regexp enode-type-spec-regexp
+          enode-pls-white-space-newline-maybe-regexp)
+  "The RETURN clause of a function"
+  )
+
+(defvar enode-is-as-regexp
+  (concat enode-pls-white-space-newline-maybe-regexp
+          "[ai]s"
+          enode-pls-white-space-newline-maybe-regexp)
+  "The IS/AS clause"
+  )
+
+(defvar enode-block-name-regexp
+  (concat "\\(" enode-pls-name-regexp "\\)"
+          enode-pls-white-space-newline-regexp)
+  "The format of a name for a block"
+  )
+
+(defvar enode-block-params-decl-regexp
+  (concat "(" enode-pls-white-space-newline-maybe-regexp "\\("
+          enode-param-spec-regexp
+          enode-pls-white-space-newline-maybe-regexp ",*"
+          enode-pls-white-space-newline-maybe-regexp "\\)+"
+          enode-pls-white-space-newline-maybe-regexp ")"
+          enode-pls-white-space-newline-maybe-regexp)
+  "The format of a set of parameters for a function or procedure"
+  )
+
+(defvar enode-block-start-regexp
+  (concat "\\(" enode-declare-regexp "\\|" enode-create-regexp
+          enode-block-type-regexp enode-block-name-regexp "\\("
+          enode-block-params-decl-regexp "\\)*\\(" enode-decl-return-regexp
+          "\\)*\\(" enode-authid-spec-regexp "\\)*" enode-is-as-regexp "\\)" )
+  "The whole \"phrase\" that starts a block"
+  )
+
+(defvar enode-block-name-match-position 8)
+
+(defun enode-block-bounds ()
+  "Determine whether we're in a package spec or body. Returns a list of the
+format (TYPE BEG END) where TYPE is 0 for spec and 1 for body and BEG and END
+are the beginning and end points of whichever.
+Returns NIL if neither."
+  ;; Variables for the start of the current block, its name, its end and where
+  ;; the point currently is.
+  (let (block-start
+        block-name
+        block-end
+        (position (point)))
+    ;; Don't go anywhere now....
+    (save-excursion
+      ;; Locate the beginning of the enclosing block
+      (setq block-start
+            (re-search-backward enode-block-start-regexp nil t))
+      ;; If one exists...
+      (if block-start
+          ;; ... get the block's name and where it ends.
+          (progn
+            (setq block-name (match-string enode-block-name-match-position))
+            (setq block-end
+                  (re-search-forward
+                   (format
+                    "^ *end %s *;"
+                    (if block-name block-name "*")
+                    )
+                   ))
+            )
+        )
+      ;; If a block exists and we're in it, return the list of its start and
+      ;; end
+      (if (and block-start (and (> position block-start)
+                                (< position block-end)))
+          (list block-start block-end)
+
+        ;; Reasons for not being in a block:
+        ;;  1.  We're outside the block
+        ;;  2.  There are no blocks in the buffer.
+        ;;  3.  We're actually in the parameter section of the block, but
+        ;;      the preceding code compared us with the previous block
+        ;;
+        ;; We need to be certain we're not in case 3.
+        
+        ;; Go to the end of the block we we just looked at or the first
+        ;; character.
+        (goto-char (if block-end block-end 1))
+        ;; Look for the next block start
+        (let ((next-block-start (re-search-forward
+                                 enode-block-start-regexp nil t))
+              next-block-start-size)
+          ;; If there is one, determine its size and see if were in the
+          ;; middle of it.
+          (if (and next-block-start
+                   (setq next-block-start-size (length (match-string 0)))
+                   (and (> position (- next-block-start next-block-start-size))
+                        (< position next-block-start)
+                        ))
+
+              ;; If we are in it, move point on a bit and try again.
+              (progn
+                (goto-char (+ position next-block-start-size))
+                (enode-block-bounds)
+                )
+            ;; Otherwise we're on a wild goose chase.
+            nil)
+          )
+        )
+      )
+    )
+  )
+
+(defun enode-line-number ()
+  "A function to tell you which line you're on in the PL/SQL block"
+  ;; (interactive)
+  
+  (let ((bounds (enode-block-bounds)))
+    (if bounds
+        (+ (count-lines (car bounds) (point))
+           (if (looking-at "^") 1 0))
+      bounds)
+    )
+  )
+
+(defun enode-goto-line (line-numb &optional char-numb)
+  "A function to bring the point to a specific line in the named or anonymous PL/SQL block
+Produces an error if in neither.
+The optional argument CHAR-NUMB also brings you to the column"
+  (interactive (list (read-from-minibuffer "Line: ")
+                     (read-from-minibuffer "Character: ")))
+
+  ;; Go to the line where the block starts...
+  (goto-char (car (enode-block-bounds)))
+
+  ;; Move the the LINE-NUMBth line.
+  (beginning-of-line (string-to-number line-numb))
+
+  ;; If we want to go to the column, move to it too.
+  (if (not (equal char-numb ""))
+      (forward-char (- (string-to-number char-numb) 1) )
+    )
+  )
+
+(defun enode-goto-pasted-line (pasted-line)
+  "A function to navigate to a specific line and column of a PL/SQL block
+using the <linenumber>/<columnnuber> notation (e.g. 679/13)"
+  (interactive (list (read-from-minibuffer "Line: ")))
+  (let ((my-line (car (split-string pasted-line "/")))
+        (my-char (cadr (split-string pasted-line "/")))
+        )
+    (enode-goto-line my-line my-char)
+    )
+  )
+
+(defun enode-pls-compile ()
+  "A function to compile a named or anonymous PL/SQL block"
+  (interactive)
+
+  ;; Determine the range of the enclosing block
+  ;; Prepare a variable for the full statement
+  ;; Get the process buffer to send it to.
+  (let ((compilable-region (enode-block-bounds))
+        full-statement
+        (sql-process (get-buffer-process "*SQL*")))
+
+    ;; If we're in a valid block...
+    (if compilable-region
+
+        ;; ... prepare the statement, including a "SHOW ERRORS" command if
+        ;; we're dealing with a named block (i.e. a "CREATE..." statement)
+        (progn
+          (setq full-statement
+                (format "%s\n/\n%s"
+                        (buffer-substring (car compilable-region)
+                                          (car (cdr compilable-region)))
+                        (save-excursion
+                          (let (start-str)
+                            (setq start-str
+                                  (re-search-backward enode-declare-regexp
+                                                      nil t))
+                            (if start-str
+                                ""
+                              "show errors\n"))
+                          )
+                        )
+                )
+
+          ;; Send the statement to the process
+          (comint-send-string sql-process full-statement)
+          )
+      )
+
+    ;; Display the results
+    (display-buffer (get-buffer "*SQL*") t)
+    )
+  )
+
+;; Some handy PL/SQL template builders.
+(defun enode-new-pls-package (pkg-name)
+  "A command to create a PL/SQL package, taking only it's name in PKG-NAME.
+It creates a file (in the current buffer's location) using the name. It then
+creates the outline of both a package spec and a package body, adding helpful
+\"show errors\" commands along the way."
+  ;; Get the name of the package.
+  (interactive "sPackage name: ")
+        ;; Set the name of the file containing the package.
+  (let ((filename
+         (concat (file-name-directory (buffer-file-name))
+                 "/" (downcase pkg-name) ".pls")
+         ))
+    ;; If the file already exists, we have a problem...
+    (if (file-exists-p filename)
+        ;; ... go no further.
+        (error (format "File (%s) for package already exists" filename))
+
+      ;; Open the file
+      (find-file-other-window filename)
+
+      ;; Create the package spec outline
+      (insert (format "\n"))
+      (insert (format "create or replace package %s is\n\n" pkg-name))
+      (insert (format "end %s;\n/\n\n" pkg-name))
+      ;; Add a little for compilation purposes (i.e. when the file is being
+      ;; run as a script)
+      (insert (format "show errors;\n\n"))
+
+      ;; Create the package body outline
+      (insert (format "create or replace package body %s is\n\n" pkg-name))
+      (insert (format "end %s;\n/\n\n" pkg-name))
+      (insert (format "show errors;\n"))
+
+      ;; Indent the file as preferred
+      (pls-indent-region (point-min) (point-max))
+      ;; Adjust the code's case as preferred.
+      (pls-adjust-case-region (point-min) (point-max))
+
+      ;; Go to the first empty line of code in the package spec.
+      (goto-char (search-backward
+                  (format "create or replace package %s is" pkg-name))
+                 )
+      (forward-line 1)
+      (pls-tab)
+      (end-of-line)
+
+      ;; Save the file and return to the user.
+      (save-buffer)
+      )
+    )
+  )
+
+(defun enode-format-parameters (params-list)
+  "A function to take a list of PL/SQL parameter specs and return them
+as a string that would properly be a set of PL/SQL function/procedure
+parameters.
+A parameter spec is itself a list of the following format:
+  (param-name param-direction by-ref data-type default-value)
+where
+  PARAM-NAME is self-explanatory;
+  PARAM-DIRECTION is either NIL, \"IN\", \"OUT\" or \"IN OUT\". If NIL, it's
+    not used;
+  BY-REF is either NIL or T. If PARAM-DIRECTION is neither \"OUT\"
+    nor \"IN OUT\", this value is meaningless;
+  DATA-TYPE is the PL/SQL data type of the parameter or a reference to
+    a table column;
+  DEFAULT-VALUE is the default value for the parameter. If it's NIL, it's not
+    used."
+        ;; Localise the passed list of parameter definitions.
+  (let ((local-params-list params-list)
+        ;; Prepare the actual string to return
+        params-string)
+    ;; For as long as there is a list of parameters...
+    (while local-params-list
+      ;; If the string to return has something, append a comma and a newline
+      ;; to it. Otherwise, initialise it.
+      (setq params-string (if params-string (format "%s,\n" params-string) ""))
+            ;; Grab the parameter at the top of the list
+      (let ((current-param (car local-params-list)))
+        ;; Set the string to return to...
+        (setq params-string
+              (format "%s%s%s%s%s"
+                      ;; what it is, followed by...
+                      params-string
+                      ;; the name of the new parameter, following by...
+                      (format "%s " (car current-param))
+                      ;; the parameter direction, and whether it's NOCOPY,
+                      ;; followed by...
+                      (if (car (cdr current-param))
+                          (let ((direction (car (cdr current-param)))
+                                (ref (car (cdr (cdr current-param)))))
+                            (format "%s%s "
+                                    (car (cdr current-param))
+                                    (if ref " NOCOPY" "")))
+                        "")
+                      ;; the parameter's type, followed by...
+                      (setq data-type (car (cdr (cdr (cdr current-param)))))
+                      ;; the parameter's default value, if specified.
+                      (if (car (cdr (cdr (cdr (cdr current-param)))))
+                          (format " DEFAULT %s"
+                                  (if (string= data-type "NUMBER")
+                                      default-value
+                                    (format "'%s'" default-value)))
+                        "")
+                      )
+              )
+        )
+      ;; Prepare the list for the next iteration of the loop
+      (setq local-params-list (cdr local-params-list))
+      )
+    ;; Couch the parameter list in brackets.
+    (format "( %s\n) " params-string)
+    )
+  )
+
+(defun enode-pls-procedure-starter
+  (proc-name return-type pkg-body-point pkg-spec-point &rest passed-params)
+  "A function to create a new PL/SQL procedure.
+If RETURN-TYPE is non-nil, then it creates a PL/SQL function.
+If PKG-BODY-POINT is non-nil, it creates the procedure in a PL/SQL package.
+If PKG-SPEC-POINT is non-nil, it puts a mention of it in the package spec.
+PKG-SPEC-POINT is useless if PKG-BODY-POINT is nil.
+PASSED-PARAMS is the list of parameters.
+
+This function should only be called by another function that has determined
+the parameters for it programatically."
+        ;; The starting statement...
+  (let ((start-stmt (format "%s%s%s%s%s"
+                            ;; If we're are creating a stand-alone thing
+                            (if (not pkg-body-point) "create or replace " "")
+                            ;; What the thing is
+                            (if return-type "function " "procedure ")
+                            ;; Its name
+                            (format "%s\n" proc-name)
+                            ;; The parameters, if any
+                            (if passed-params (enode-format-parameters
+                                               passed-params) "")
+                            ;; What it returns, if applicable.
+                            (if return-type (format "return %s" return-type)
+                              "")
+                            ))
+        ;; The ending statement.
+        (end-stmt (format "end %s;\n" proc-name))
+        (start-point (if (not pkg-body-point)
+                         (point-min)
+                       (save-excursion
+                         (goto-char pkg-body-point)
+                         (forward-line 1)
+                         (point))))
+        end-point
+        )
+
+    ;; Go to where we're going to put the information
+    (goto-char start-point)
+
+    ;; Insert the generated lines.
+    (insert (format "\n%s is\n\n" start-stmt))
+    (insert (format "begin\n\n"))
+    (insert (format "%s" end-stmt))
+
+    (pls-indent-region start-point (point))
+    (pls-adjust-case-region start-point (point))
+
+    ;; If we're in a package and we want to expose the thing through
+    ;; its spec...
+    (if (and pkg-body-point pkg-spec-point)
+        (progn
+          ;; ... go to the first line after the declaration of the spec,
+          (goto-char pkg-spec-point)
+          (forward-line 1)
+          (setq start-point (point))
+          ;; and insert the generated line.
+          (insert (format "\n%s;\n" start-stmt))
+
+          (pls-indent-region start-point (point))
+          (pls-adjust-case-region start-point (point))
+
+          )
+      )
+    )
+  )
+
+(defun enode-pls-function ()
+  "A function to take information on a new PL/SQL function"
+        ;; Get the function's name
+  (interactive)
+  (let ((function-name (read-from-minibuffer "Function name: "))
+        ;; Get the return type
+        (return-type (read-from-minibuffer "Function returns: "))
+        ;; Get the list of parameters.
+        (params-list (enode-get-parameters))
+        )
+          ;; Are we in a package?
+    (let ((pkg-points (enode-in-pls-package))
+          in-spec
+          )
+      ;; If we're in a package
+      (if (cdr pkg-points)
+          ;; Find out if we want to expose the function
+          (let (have-it)
+            (while (not have-it)
+              (setq in-spec (read-from-minibuffer
+                             "In package spec? (Y/N): " "N"))
+              (if (or (string= in-spec "Y") (string= in-spec "y")
+                      (string= in-spec "N") (string= in-spec "n"))
+                  (setq have-it t)
+                )
+              )
+            (if (or (string= in-spec "N") (string= in-spec "n"))
+                (setq in-spec nil)
+              )
+            )
+        )
+      ;; Call enode-pls-procedure-starter with the proper parameters.
+      (apply
+       'enode-pls-procedure-starter
+       function-name
+       return-type
+       (cdr pkg-points)
+       (if in-spec (car pkg-points) nil)
+       params-list)
+      )
+    )
+  )
+
+(defun enode-get-parameters ()
+  "A function to get a list of parameters"
+  (interactive)
+        ;; Some intialisations
+        ;; The list to return
+  (let (params-list
+        ;; Whether we're done gathering parameters
+        finished
+        ;; The name of the first parameter
+        (param-name (read-from-minibuffer
+                     "Parameter name (blank for no more parameters): "))
+        )
+
+    ;; If the first name is blank, we came in here by accident
+    (if (string= param-name "")
+        (setq finished t)
+      )
+
+    ;; Until we're finished...
+    (while (not finished)
+      ;; Get the parameter's direction
+      (setq param-direction (read-from-minibuffer
+                             "IN, OUT, IN OUT? (blank for nothing) "))
+      ;; If the direction is blank, nilify it.
+      (if (string= param-direction "") (setq param-direction nil))
+
+      ;; If we're creating an OUT or IN OUT parameter, get the NOCOPY
+      ;; requirements
+      (setq by-ref (if (or (string= param-direction "OUT")
+                           (string= param-direction "IN OUT"))
+                       (if (string= (read-from-minibuffer "NOCOPY? " "N") "Y")
+                           t)
+                     nil))
+
+      ;; Get the return type.
+      (setq data-type (read-from-minibuffer "Data type: " "NUMBER"))
+
+      ;; Get the default value.
+      (setq default-value (read-from-minibuffer "Default value: "))
+      ;; If the default value is blank, nilify it.
+      (if (string= default-value "") (setq default-value nil))
+
+      ;; Add the new parameter to the list
+      (setq params-list
+            (cons (list param-name
+                        param-direction
+                        by-ref
+                        data-type
+                        default-value)
+                  params-list))
+
+      ;; Get the name of the next parameter.
+      (setq param-name (read-from-minibuffer
+                        "Parameter name (blank for no more parameters): "))
+      ;; If that's blank, we're done.
+      (if (string= param-name "")
+          (setq finished t)
+        )
+      )
+
+    ;; If we have a list of parameters, return it reversed.
+    (if params-list
+        (nreverse params-list)
+      nil)
+
+    )
+  )
+
+(defun enode-in-pls-package ()
+  "A function to determine whether we're in a PL/SQL package file.
+It returns a list of (spec-start-point . body-start-point)"
+  (let ((package-body-regexp
+         (concat enode-create-regexp
+                 "package"
+                 enode-pls-white-space-regexp
+                 "body"
+                 enode-pls-white-space-regexp
+                 enode-block-name-regexp
+                 enode-is-as-regexp)
+         )
+        (package-spec-regexp
+         (concat enode-create-regexp
+                 "package"
+                 enode-pls-white-space-regexp
+                 enode-block-name-regexp
+                 enode-is-as-regexp)
+         )
+        body-start-point
+        spec-start-point
+        )
+    (save-excursion
+      (setq body-start-point (re-search-backward package-body-regexp nil t)))
+    (save-excursion
+      (setq spec-start-point (re-search-backward package-spec-regexp nil t)))
+    (if (and (null body-start-point) (null spec-start-point))
+        nil
+      (cons spec-start-point body-start-point)
+      )
+    )
+  )
+
+(defun enode-pls-procedure ()
+  "A function to take information on a new PL/SQL procedure"
+        ;; Get the procedure's name
+  (interactive)
+  (let ((procedure-name (read-from-minibuffer "Procedure name: "))
+        ;; Get the list of parameters.
+        (params-list (enode-get-parameters))
+        )
+          ;; Are we in a package?
+    (let ((pkg-points (enode-in-pls-package))
+          in-spec
+          )
+      ;; If we're in a package
+      (if (cdr pkg-points)
+          ;; Find out if we want to expose the procedure
+          (let (have-it)
+            (while (not have-it)
+              (setq in-spec (read-from-minibuffer
+                             "In package spec? (Y/N): " "N"))
+              (if (or (string= in-spec "Y") (string= in-spec "y")
+                      (string= in-spec "N") (string= in-spec "n"))
+                  (setq have-it t)
+                )
+              )
+            (if (or (string= in-spec "N") (string= in-spec "n"))
+                (setq in-spec nil)
+              )
+            )
+        )
+      ;; Call enode-pls-procedure-starter with the proper parameters.
+      (apply
+       'enode-pls-procedure-starter
+       procedure-name
+       nil
+       (cdr pkg-points)
+       (if in-spec (car pkg-points) nil)
+       params-list)
+      )
+    )
+  )
+
+(defun pls-present-code-region (beg end &optional reverse)
+  "A function to highligh a region of code. Net really necessary here, and
+I suppose it's likely to be implemented elsewhere, but I can't find it at
+present. If REVERSE is true, it unpresents the code."
+  (interactive "r")
+        ;; What to start the highlighting with.
+  (let ((present-begin "===> ")
+        ;; What to end the highlighting with.
+        (present-end   " <===")
+        ;; The piece of code of interest
+        (code-chunk (if (not reverse)
+                        (buffer-substring beg end)
+                      (buffer-substring (+ beg 5) (- end 5)))))
+    ;; Remove the region passed.
+    (delete-region beg end)
+    ;; Insert the code section again, adding or removing highlights as
+    ;; required.
+    (insert (format "%s%s%s"
+                    (if reverse "" present-begin)
+                    code-chunk
+                    (if reverse "" present-end)))
+    ;; Return the new end position of the relevant section
+    (if reverse (- end 10) (+ end 10))
+    ))
+
+(defun pls-convert-comments (beg end &optional do-query)
+  "To convert c-style comments to preferred PL/SQL style comments. Does this
+with comments from point to the end. If prefix option DO-QUERY is passed,
+user is prompted before making change."
+  (interactive "r
+P")
+  ;; Go to the beginning of the region
+  (goto-char beg)
+  (setq region-end end)
+  ;; Look for all openings of comment blocks
+  (while (re-search-forward "/\\*" region-end t)
+    ;; Go back two characters to determine the starting position of the comment
+    (backward-char 2)
+    (setq my-comment-start (point))
+
+    ;; Determine the end position of the comment.
+    (setq my-comment-end (save-excursion (re-search-forward "\\*/" nil t)))
+
+          ;; We want to convert this comment.
+    (let ((do-conv t))
+
+      ;; If we want to ask about all the comments...
+      (if do-query
+                ;; ...highligh the block and determine the new end position
+          (let ((new-end
+                 (pls-present-code-region my-comment-start my-comment-end))
+                ;; Ask the question
+                (my-ans (y-or-n-p
+                         "Convert this comment? ")))
+            ;; If the answer is "no"...
+            (if (not my-ans)
+                ;; ... mark the do-conv flag as nil
+                (setq do-conv nil))
+            ;; un-highlight the block
+            (pls-present-code-region my-comment-start new-end t)
+            ))
+      ;; If we are to convert the block...
+      (if do-conv
+          (let ((current-region-size (- my-comment-end my-comment-start))
+                new-region-size)
+            ;; ... go to the start of the comment...
+            (goto-char my-comment-start)
+            ;; ... and delete the next two charaters (the "/*")
+            (delete-char 2)
+
+            ;; Go to the end of the block now that the first two
+            ;; characters have been deleted, and come back another two...
+            (goto-char (- my-comment-end 4))
+            ;; ... and delete them too.
+            (delete-char 2)
+
+            ;; Reset the end position of this comment.
+            (setq my-comment-end (point))
+
+            ;; Use the in-built commenting function to comment out
+            ;; the defined region. This satisfies my requirements
+            ;; beautifully.
+            (comment-region my-comment-start my-comment-end)
+            ;; Commenting this out. We need to track the change to the
+            ;; size of the buffer, and until I get a good example of
+            ;; why the unwind-protect is required, I can't cater for this.
+            ;; (let ((do-commenting nil))
+            ;;   (unwind-protect
+            ;;       (setq do-commenting (comment-region my-comment-start my-comment-end))
+            ;;     (if (not do-commenting)
+            ;;         (progn
+            ;;           (goto-char my-comment-start)
+            ;;           (beginning-of-line)
+            ;;           (while (< (point) my-comment-end)
+            ;;             (insert "-- ")
+            ;;             (forward-line 1)
+            ;;             )
+            ;;           )
+            ;;       )
+            ;;     )
+            ;;   )
+
+            ;; Get the new region end.
+            (setq new-region-size (- (point) my-comment-start))
+            (setq region-end
+                  (+ region-end (- new-region-size current-region-size)))
+
+            ) ;; end let
+        ) ;; end if
+      ) ;; end let
+    ) ;; end file
+  (message "Done.")
+  region-end
+  )
+
+(defun pls-convert-comments-buffer (&optional do-query)
+  "Convert the /* ... */ comments for the whole buffer"
+  (interactive "P")
+  (pls-convert-comments (point-min) (point-max) do-query)
+  )
+
+(defun pls-prepare-for-comparison (beg end)
+  "Prepare a PLSQL region for comparison. Should really be done on the whole
+buffer"
+  (interactive "r")
+  (pls-mode)
+  (save-excursion
+    ;; Remove trailing spaces at the end of lines.
+    (goto-char beg)
+    (while (re-search-forward "[	 ]+$" end t)
+      (replace-match "")
+      (setq end (- end (length (match-string 0))))
+      )
+    ;; Replace tab characters with space characters
+    (goto-char beg)
+    (while (re-search-forward "[	]+" end t)
+      (replace-match " ")
+      (setq end (- end (- (length (match-string 0)) 1)))
+      )
+    ;; Convert comments. I want to make this interactive as
+    ;; hints probably shouldn't be converted.
+    (setq end (pls-convert-comments beg end t))
+    ;; Change the case of the region
+    (pls-adjust-case-region beg end)
+    ;; Indent the region
+    (indent-region beg end nil)
+    )
+  )
+
+
+(defun pls-prepare-for-comparison-buffer ()
+  "Prepare a PLSQL buffer for comparison."
+  (interactive)
+  (pls-prepare-for-comparison (point-min) (point-max))
+  )
+
+(provide 'pls-extras)

enode-lisp/sql-extras.el

@@ -0,0 +1,24 @@
+
+(defun sql-area-add-table (table-name)
+  "A simple function to add a new table to the SQL file."
+  (interactive "sTable name: ")
+  
+  (let ((table-name (upcase table-name)))
+    (if (eq major-mode 'sql-mode)
+        (if (progn
+              (goto-char (point-min))
+              (re-search-forward (format "^-- Table: %s$" table-name) nil t))
+            (error "Table %s is already there" table-name)
+          (goto-char (point-max))
+          (goto-char (re-search-backward "^-- Table: .+"))
+          (insert (format "-- Table: %s\n\n" table-name))
+          (insert (format "desc %s\n\n" table-name))
+          (insert (format "select count(*) %s\nfrom   %s;\n\n"
+                          table-name table-name))
+          )
+      (error "Are you in an sql-mode buffer?")
+      )
+    )
+  )
+
+(provide 'sql-extras)