From aeeab31ecfed473b7879191cc7336ae33c26a4b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=89ibhear=20=C3=93=20hAnluain?= Date: Wed, 5 Oct 2016 21:35:21 +0100 Subject: [PATCH] The code files. Taken from assembla working copy --- enode-lisp/enode-oracle.el | 765 ++++++++++++++++++++++++ enode-lisp/enode.el | 1132 ++++++++++++++++++++++++++++++++++++ enode-lisp/pls-extras.el | 806 +++++++++++++++++++++++++ enode-lisp/sql-extras.el | 24 + 4 files changed, 2727 insertions(+) create mode 100755 enode-lisp/enode-oracle.el create mode 100755 enode-lisp/enode.el create mode 100755 enode-lisp/pls-extras.el create mode 100755 enode-lisp/sql-extras.el diff --git a/enode-lisp/enode-oracle.el b/enode-lisp/enode-oracle.el new file mode 100755 index 0000000..e14fed5 --- /dev/null +++ b/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', '<>' ) + ;; 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) diff --git a/enode-lisp/enode.el b/enode-lisp/enode.el new file mode 100755 index 0000000..4cf34bf --- /dev/null +++ b/enode-lisp/enode.el @@ -0,0 +1,1132 @@ +;; ENODE -- ENODE is Not an Oracle Development Environment +;; A package and 'mode' for providing an interface for examining and +;; developing for relational databases. + +;; Drawing on TOAD by Quest Software as inspiration, this is provides an emacs +;; based interface to examine and develop for a relational database. It's +;; hoped that the following databases will ultimately supported: +;; mysql +;; postgres +;; oracle +;; In fact, the proof-of-concept will be developed for an oracle database, +;; and as I will have reasonably easy access to mysql and postgres databases, +;; They will follow suit. I indend to provide high-level interfaces to +;; databases, so it will be easy to develop a layer for interacting with +;; databases from other vendors. +;; +;; Initially, the following functionality will be provided: +;; Interface -- look and feel. +;; Connect and disconnect, plus management of saved connection information. +;; Database object listing and examination. +;; Area for typing of ad hoc SQL statements. +;; Presentation of SQL query output. +;; - There'll be no facility to change data as presented from a query. +;; However, update, delete and insert commands will be facilitated +;; through the SQL area. +;; +;; Interface -- look and feel. +;; The emacs frame will be divided into three windows: +;; - The 'object list' or 'navigator' window. +;; + Here will be listed in tree format the various objects that a +;; schema has. Hierarchy will be something like: Schema, objects +;; (tables, views, packages, etc.), columns/indexes (for tables and +;; views) or procedures/functions (for packages), parameters, etc. +;; + The user will enter and leave this window by key strokes or +;; mouse clicks. +;; + An object is selected by clicking with the middle button or +;; hitting return when point is somewhere on its name. Once +;; selected, information will be presented in the information frame +;; (see below). +;; + As a tree structure will be used, opening and closing of nodes +;; will result from selection of the node as described. Selecting an +;; 'open' node will 'close' it and vice versa. +;; + A node can be closed or opened using the left and right arrow +;; keys. This will not result in selecting the node, therefore +;; preserving the information presented. +;; + This window can present any of a number of buffers. However, each +;; of these buffers must be of a perticular type (e.g. navigator), +;; and will have a local key map specific to its use. Separation of +;; the buffers will facilitate management -- one buffer for tables, +;; another for views, etc. +;; + The top node for each buffer will be the name of the schema owner. +;; + The user can toggle between showing only one schema owner in the +;; list or all of them +;; - The information window. +;; + This will present information on the item from the navigation +;; window that has most recently been selected. +;; + The user can navigate to this window by way of key stroke or +;; mouse click. +;; + The window will provide a subset of all the information on the +;; object, and a menu to facilitate showing other information. +;; + This window can present any of a number of buffers. There will be +;; a separate buffer type for each type of information being +;; displayed (i.e. table columns are presented differently from a +;; table's indexes, which is also different from the list of +;; triggers on the table, etc.) +;; - The SQL interaction window. +;; + This window will present one of two buffers -- the SQL input +;; buffer and the SQL result buffer. +;; + They can both be presented, but at the expense of the other +;; windows. +;; + In the SQL input buffer, entering commands will be as simple as +;; entering SQL commands in any sql-mode buffer. +;; + Indentation will eventually be based on my preferred indentation +;; scheme, as I am the dictator, and not necessarily benevolent. +;; + Execution of the command will involve typing a key stroke rather +;; than the RET key as we will want to format the command nicely. +;; + The output buffer will present data in one of two formats: +;; > Select commands will present the selected data in grid format. +;; > Other commands will generate output in simply sequential +;; output format. +;; - Possible arrangements can include: +;; + Three windows in two rows. The navigator and information windows +;; in the upper row, the latter being the wider. The SQL interaction +;; window being in the lower. The upper row would be the higher. +;; + Three windows in two columns. The navigator in the first column, +;; and the information and SQL interaction windows in the second. +;; The latter column will be the wider and the information window +;; will be higher than the SQL interaction window. +;; + Two windows in either columnar or tiered format. The user decides. +;; The windows will be related by function: The navigator and +;; information windows together with the latter getting more space; +;; the SQL input and output windows together, each getting equal or +;; similar space. The SQL window can be displayed in one of the +;; first two configurations if a function is called from the +;; information window that warrants it. +;; - Help information. +;; + Help can be brought up by typing the '?' key. This will present +;; the list of key strokes that perform tasks in the window which +;; has focus. +;; + The help display will be presented in the SQL interaction window, +;; which will be presented if it isn't already. +;; + If the focus is already in a buffer in the SQL interaction window, +;; the help screen will be presented in the largest visible other +;; window. +;; + Typing the '?' key in the help buffer will replace its contents +;; with all the keystrokes possible based on the type of buffer +;; supported and listing key strokes that work all over ENODE. +;; + The user can return to the buffer of most recent focus using +;; a single key stroke. +;; + The user can dismiss the help screen and replace the windows to +;; their previous configuration by typing the 'q' key while in the +;; help buffer. +;; +;; +;; Connect and disconnect. +;; - Upon startup, ENODE will ask for connection information in almost +;; precisely the manner in which sql-.+ asks for it -- using the +;; minibuffer to get the username, password and database information. +;; - ENODE will save each connection information in a history file, +;; and will maintain a completion list or lists to facilitate quick +;; connection. For connections to new databases, ENODE will ask for +;; the type of database (mysql, oracle, etc). This will be stored with +;; the connection information. +;; - The actual commands that will be executed against the database will +;; be based on the type of database being used. However, this will +;; mainly be hidden from the user. +;; - ENODE will facilitate concurrent connections. +;; - A list of possible connections can be presented in the navigation +;; screen. Open connections will be marked. Opening a closed connection +;; involved 'selecting' it. Closing an open connection should not be +;; that easy, and will involve a key stroke followed by an 'Are you +;; sure?' question. Selecting an open connection which is not the +;; current connection makes that connection current. +;; Each connection can be represented in this list either by an alias +;; given to it explicitly by the user or by a connection string in the +;; format of something like /@ +;; - Switching between connections will be at the drop of key stroke. +;; + It will be wise to figure out from the start how new connections +;; effect the buffers being displayed at the time. +;; + See above regarding switching between connections using the +;; navigator window. +;; - Closing connections can be done by one of two means: +;; + Close the current connection. Done with a key stroke and a +;; response to an 'Are you sure?' question, the next connection in +;; the list of open connections will be activated. If we are closing +;; the final connection ENODE will report this but not close the +;; application. +;; + Place the point in the connection in the navigator and execute a +;; key stroke. +;; +;; Database object listing and examination. +;; - The most useful window here will be the navigator. It will list the +;; objects of interest in a tree structure. There will be separate lists +;; for tables, views, indexes and stored procedure/functions/packages. +;; tables will drill down to triggers, columns, indexes and constraints. +;; Columns will drill down to triggers, indexes and constraints. +;; Views will drill down similarly. Packages will drill down to specs +;; and bodies. Specs will drill down to types/procedures/functions/etc. +;; Bodies will drill down to functions/procedures. Functions/procedures +;; will drill down to parameter lists and return types (where +;; appropriate). +;; - The types of information displayed and the information itself will +;; depend on the selected item, examples of which are: +;; + Tables +;; > Data +;; > Columns +;; > Constraints +;; > Indexes +;; > Triggers +;; + Views +;; > Data +;; > Columns +;; > Source +;; + Constraints +;; > Tables/Columns +;; + Packages/procedures/functions +;; > Dependancies +;; > Source +;; + Triggers +;; > Tables +;; > Source +;; In the case of views and tables, if we want to see data, it is to be +;; displayed in the SQL interaction window. +;; +;; Area for typing of ad hoc SQL statements. +;; - This will display the SQL input buffer. +;; - SQL commands can be typed as free text into the buffer. +;; - Using key strokes, certain actions can then be run on the command in +;; the buffer: execute, parse/compile, explain execution plan, etc. +;; - Depending on a prefix argument to each of the key strokes commands, +;; they will be executed on the contents of the buffer, the SQL command +;; the point is currently in or on the commands that are in the region. +;; - It will be possible to save the contents to a file. +;; - It will be possible to clear the contents in one go. +;; - It will be possible to insert the contents of a file, either after +;; point or by first clearing the buffer. +;; - Inserting the contents of the file into the buffer will not mean +;; visiting the file. That functionality will come later. +;; +;; Presentation of SQL (query) output. +;; - For commands other than select statements, the output presented will +;; be as if the commands had been run on the command line. +;; - Output from queries will be presented in a grid manner, the +;; configuration of which will be decided after some initial testing. +;; +;; Internals +;; - ENODE will maintain many lists which will be used extensively. These +;; will all be association lists. All the elements of these lists will be +;; string values, not symbols. Depending on the case sensitivity of the +;; database system, these will be case sensitive or not. The following +;; are some of these lists: +;; + Databases. This list will be populated with the first database we +;; connect to. The variable describing the current database will +;; contain a string value from this list. +;; + Schema owners. There will be a separate list of schema owners +;; per database. As we connect to databases afresh, the first two +;; elements of this list will be the user we connect as and the +;; system/root schema. The variable describing the current schema +;; owner we're connected as will contain an element from this list. +;; If the user requests to see any information pertaining to a schema +;; owner (s)he is not connected as, this list is populated fully. +;; This list can be refreshed by typing the refresh key stroke while +;; a schema owner has been selected in the navigation window. +;; Refreshing the list also refreshes its presentation in the +;; navigation window. +;; + Tables. There will be a separate list for each owner. This list +;; will be populated for the current schema owner as we connect +;; for the first time. It will be populated for other schema owners +;; as we request information on a table owned by that schema owner. +;; This list can be refreshed by typing the refresh key stroke while +;; a table is selected in the navigation window. +;; + Views. There will be a separate list for each owner. This list +;; will be populated for the current schema owner as we connect for the +;; first time. It will be populated for other schema owners as we +;; request information on a view owned by that schema owner. This list +;; can be refreshed by typing the refresh key stroke while a view is +;; selected in the navigation window. +;; + Constraints. +;; + Columns. A list per table or view. +;; + Indexes. A list per table. +;; + Packages. A list per schema owner. +;; + Procedures. A list per schema owner for non packaged procedures, a +;; list per package for packaged. +;; + Functions. A list per schema owner for non packaged functions, a +;; list per package for packaged. +;; +;; - Refreshing a list. +;; The following will happen when a command to refresh a list is called. +;; 1. An empty list will be created. +;; 2. The command to populate this new list will be executed. +;; 3. The contents of the new list will be compared with the existing +;; list and newer elements will be added to it. Elements that are +;; in the old list and are missing from the new will be removed from +;; the old. +;; 4. If the eode-refresh-recursively variable is non-nil, then +;; any sublists will also be refreshed. in this manner. +;; 5. Elements of a list that can have a sublist but that sublist +;; is nil at the time of the refresh will not have that list +;; populated. I.e. we don't refresh a list that hasn't been populated +;; yet. +;; The following will be applied during a list refresh: +;; 1. The node in the navigation list will be 'closed' before the +;; refresh begins. +;; 2. The node's parent node will be 'closed'. +;; 3. After the refresh, the parent's node will be opened again. +;; 4. If the node that had been selected at the time of the call to +;; refresh exists after the refresh, the point is sent to it and +;; it is explicitly 'selected'. If it doesn't, the node's parent +;; node is 'selected'. +;; +;; - Interacting with the database. +;; + The main engine will be the sql- functionality that is +;; provided as standard with GNU/Emacs distributions. +;; + All commands will be run in the background and will use the +;; comint-redirect-send-command* functionality. +;; + Lists will be read from temporary buffers. +;; + Presented SQL output will probably have outputting formatting +;; specified for the actual SQL interpreter being used and send to +;; the SQL output buffer. +;; +;; - Context. +;; There will be variables that will maintain: +;; + The current database and the most recent one. +;; + The current schema owner and the most recent one. +;; + The current table/view/package/etc. and the most recent one. +;; There will be a separate pair of variables for each type of +;; object ENODE supports. +;; + The current selected item. I.e. There is a table named "FOO" and +;; an index named "BAR". Both the enode-current-table, +;; enode-current-index and enode-selected-item are nil. The +;; user navigates to "FOO" in the navigation window and selects it. +;; enode-current-table and enode-selected-item are set to "FOO". +;; enode-current-index is still nil. The user then navigates to the +;; "BAR" index and selects it. enode-selected-item and +;; enode-current-index are set to "BAR", but enode-current-table +;; remains set to "FOO". +;; + The previous selected item. +;; + The current buffer and the previous one. +;; + The current window and the previous one. +;; +;; A typical session might be: +;; 1. A user calls the command M-x enode. +;; 2. The user is asked to enter a connection string, and is presented with +;; a default which is the most recently used connection. +;; 3. The user can accept the default, use M-p and M-n to scroll through +;; a list of saved connections, type in a connection (using completion +;; to assist) or type in a new connection name or type in '+'. +;; 4. If the default is accepted that connection string is used to connect. +;; If a connection from the list is entered, it's used. If a connection +;; name that isn't on the list is entered, the user wants to create a +;; new connection with that name. If '+' is entered, the user wants +;; to create a new connection but doesn't know what to call it. +;; 5. If one of the last two, the user is asked for the type of database +;; we want to connect to. +;; 6. Based on that, the sql- function is called and the user is +;; then prompted to enter the appropriate information. +;; 7. Once connected, the windows are initialised based on the user's +;; customisation. +;; 8. The list of databases is initialised. The current database is set. +;; 9. The list of schema owners is initialised. If the user prefers to see +;; all the schema owners in the navigation window at once, this list is +;; populated with all the schema owners in the database. If not, this +;; list is initialised to the requested schema owner and the +;; system/root user. The current schema owner is set. +;; 10. The point is brought to the schema owner and the information for +;; that user is presented in the information window. enode-selected-item +;; is set. + +;; If we want oracle shtuff. +(require 'enode-oracle) + +;; Some handy stuff that really should be part of ENODE but isn't +(require 'sql-extras) +(require 'pls-extras) + +;; +;; Customisable stuff +;; + +;; The customisation group. Should be in the SQL group, but will also +;; put it into the local group. +(defgroup enode nil + "A group for customising ENODE: +The bestest database development environment ever developed for emacs." + :group 'local + :group 'SQL + :version "21.2" + ) + +(defcustom enode-projects-dir nil + "The location down which the SQL files for the projects will be found. +For each project, there will be a directory in this directory named for the project, a subdirectory named \"scripts/sql\" and in it will be a file named \"_ENODE.sql\". This directory is used to determine the projects being used." + :type 'directory + :group 'enode + :version "21.2" +) + +(defcustom enode-project-sql-file-dir nil + "The directory beneath the specific project directory, which in turn is a +subdirectory of ENODE-PROJECTS-DIR, in which the SQL \"seed\" file for the +project can be found." + :type 'directory + :group 'enode + :version "21.2" +) + +;; The preferred window configuration: +(defcustom enode-initial-window-arrangement "3r" + "How do you prefer the windows to be arrayed. +Current options are: +3r: 3 windows arrayed in rows -- The navigator and the information windows + in the first row, the SQL interaction window in the second. +3c: 3 windows arrayed in columns -- The navigator in the first column, the + information and SQL interaction windows in the second. +2c: 2 windows arrayed in columns. These are the navigator and the information + windows. +2r: 2 windows arrayed in rows. These are the SQL input and SQL output windows." + :type '(choice (const :tag "Three windows, two above, one below" "3r") + (const + :tag "Three windows, one to the left and two to the right" + "3c") + (const + :tag "Two windows, navigator to the left, information to the right" + "2c") + (const + :tag "Two windows, SQL input above, SQL output below" + "2r") + ) + :group 'enode + :version "21.1" + ) + +;; Show the schema owner alone in the navigation window, or all the +;; schema owners. +(defcustom enode-show-all-schema-owners nil + "Whether to show all the schema owners in the navigation window. +If non-nil, all the schema owners will be listed. If nil, only the current +schema owner." + :type '(choice (const :tag "Only the current schema owner" nil) + (const :tag "All schema owners" t) + ) + :group 'enode + :version "21.1" + ) + +;; The location of the enode files. +(defcustom enode-directory "~/.enode" + "The directory where enode's configuration files will be stored" + :type 'directory + :group 'enode + :version "21.2" + ) + +;; The file for containing connection information +(defcustom enode-connections-file (concat enode-directory "/enode-connections") + "The file that contains the list of previous and saved connections. +The file will be an alist. Each element will be the name of the connection +and then a list of the information needed to make the connection: database +vendor, username, server, host. Password will never be stored." + :type 'file + :group 'enode + :version "21.2" + ) + +;; The file for containing project information +(defcustom enode-projects-file (concat enode-directory "/enode-projects") + "The file that contains the list of projects used with ENODE." + :type 'file + :group 'enode + :version "21.2" + ) + +;; +;; Non-customisable variables +;; + +;; A simple way to change a project in a current ENODE session. +;; Not very robust. +(defalias 'enode-project 'enode) + +(defvar enode-progress-message ".") + +(defvar enode-selected-item nil + "The currently selected item from the navigator. +This is the item whose information is displayed in the information window.") + +(defvar enode-previous-database nil + "The most recent database in use") + +(defvar enode-previous-schema-owner nil + "The most recent schema owner in use") + +(defvar enode-current-table nil + "The current table being examined") + +(defvar enode-previous-table nil + "The table examined immediately before enode-current-table") + +(defvar enode-projects nil + "The alist of projects that ENODE handles for the user") + +(defvar enode-connections nil + "The alist of connections that ENODE handles for the user") + +(defvar enode-current-connection-type nil + "The current connection type: 'oracle, 'mysql, etc.") + +(defvar enode-supported-connection-types '(oracle) + "The current connection type: 'oracle, 'mysql, etc.") + +(defvar enode-current-connection nil + "The current connection.") + +(defvar enode-passwords-in-use nil + "Those passwords that have been input in this session") + +(defvar enode-up nil + "Nil if ENODE is not \"running\", non-NIL if it is.") + +(defvar enode-connected nil + "Nil if ENODE is not connected to a database, non-NIL if it is.") + +(defvar enode-launched-as-application nil + "If ENODE has been launched as an application rather than during an otherwise +useful emacs session.") + +;; +;; Some constants. Defined here and will be used throughout the code. +;; + +;; The buffer that will be used to pick up the output from SQL commands. +(defconst enode-sql-command-output-buffer + (get-buffer-create " *ENODE-command-output*") + "This is the buffer that SQL output will be directed to where the information +can be picked up from.") + +;; +;; Exposed functions +;; +(defun enode-automatic () + "So that enode can be launched from the command-line. It asks for the +project in the body of the function rather than as part of a call to +INTERACTIVE" + (interactive) + (let ((the-project (completing-read "Project: " + (enode-available-projects) + nil + t)) + ) + (setq enode-launched-as-application t) + (enode the-project) + ) + ) + +(defun enode (enode-project) + "Launch the enode system" + ;; The name of the project we're interested in. + (interactive (list (completing-read "Project: " + (enode-available-projects) + nil + t)) + ) + ;; We're connecting to an Oracle database + (setq enode-current-connection-type + (cadr (assoc enode-project enode-projects))) + ;; Load functions for that engine + ;; (load-file (format "enode-%S.el" enode-current-connection-type)) + ;; Let's call + (enode-start-engine) + (other-window 1) + ;; The project's "general purpose" SQL file. + (let ((sql-file-name (format "%s/%s/%s/%s_ENODE.sql" + enode-projects-dir + enode-project + enode-project-sql-file-dir + enode-project))) + (find-file sql-file-name) + ) + (setq enode-up t) + ;; The SQL engine is called without connection information. Log in now. + (call-interactively 'enode-connection) + ) + +(defun enode-start-engine() + "A function to start the SQL engine for the connection type" + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-start-sql-engine)) + ) + ) + +(defun enode-stop-engine() + "A function to stop the SQL engine for the connection type" + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-stop-sql-engine)) + ) + ) + +(defun enode-connect (connection-description) + "A function to initiate a connection based on connection type" + (let ((conn-details (cdr (assoc connection-description + (enode-get-connections)))) + ;; Somewhere to come back to. + (active-buffer (current-buffer)) + ) + ;; The user to connect as + (setq conn-user (car conn-details)) + ;; The database to connect to + (setq conn-connection (caddr conn-details)) + ;; The password to use: if it's not in the saved connection + ;; details... + (setq conn-pass (if (not (cadr conn-details)) + ;; ... if it's one of the locally saved + ;; passwords... + (if (assoc connection-description + enode-passwords-in-use) + ;; ... use it. + (car (cdr (assoc connection-description + enode-passwords-in-use))) + ;; otherwise... + ;; Read the password from the user + (let ((my-conn-pass + (read-passwd + (format "Password for %s on %s: " + conn-user + conn-connection)))) + ;; add it to the list of those in use. + (setq enode-passwords-in-use + (cons (list connection-description + my-conn-pass) + enode-passwords-in-use)) + my-conn-pass)))) + ;; The SQL prompt for the SQL engine + (setq conn-prompt (cadddr conn-details)) + (cond ((eq 'oracle enode-current-connection-type) + ;; Connect. + (enode-oracle-connect conn-user conn-pass conn-connection + conn-prompt) + ) + ) + ;; Say who we're now connected to. + (setq enode-current-connection connection-description) + (setq enode-connected t) + (set-buffer active-buffer) + ) + ) + +(defun enode-disconnect () + "A function to close a connection to the database" + (interactive) + ;; Somewhere to come back to. + (let ((active-buffer (current-buffer))) + (cond ((eq 'oracle enode-current-connection-type) + ;; Disconnect. + (enode-oracle-disconnect) + ) + ) + ;; Say who we're now connected to. + (setq enode-current-connection nil) + (setq enode-connected nil) + (set-buffer active-buffer) + ) + ) + +(defun enode-query-connection () + "A function to tell you who you are and what system you're connected to" + (interactive) + ;; Print out the information + (message (cond ((not enode-up) "ENODE not running") + ((not enode-connected) "ENODE not connected") + (t enode-current-connection)) + ) + ) + +(defun enode-connection (connection-description) + "A command to connect to another user" + ;; Get a connection description from the minibuffer + (interactive (list (completing-read "Connection: " + (enode-get-connections) + )) + ) + ;; If the passed description is not a saved description... + (if (not (assoc connection-description (enode-get-connections))) + ;; ... get the relevant information and save it. + (enode-add-new-connection connection-description) + ) + ;; Details for this connection from the list of available connections + (enode-connect connection-description) + ) + +(defun enode-clear-stored-password (username) + "A function to clear a password from a list of passwords" + ; Whose password we want to clear. + (interactive (list (completing-read "User: " + enode-passwords-in-use + )) + ) + ;; Create two temporary lists... + ;; ... the first based on the current password list + (let ((tmp-password-list enode-passwords-in-use) + ;; the second a blank list to build a new list. + tmp-password-list-2) + ;; For as long as the first list is not empty... + (while tmp-password-list + ;; ... if the first entry is not the username we're interested in... + (if (not (string= (caar tmp-password-list) username)) + ;; ... add the first entry to the new list. + (setq tmp-password-list-2 (cons (car tmp-password-list) + tmp-password-list-2)) + ) + ;; Remove the first entry from the temporary list + (setq tmp-password-list (cdr tmp-password-list))) + ;; Reset the password list with the password information of interest + ;; removed. + (setq enode-passwords-in-use tmp-password-list-2) + ) + ) + +(defun enode-list-users () + "A function to throw up a list of the database users for the current +connection." + (interactive) + ;; A buffer to send the information to + (let ((user-list-buffer (enode-buffer "*ENODE-users*"))) + ;; How are we connected? + ;; Oracle database... + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-list-users user-list-buffer) + ) + ) + ;; Go to the buffer with the information + (display-buffer user-list-buffer) + ;; We're done. + (message "Done.") + ) + ) + +(defun enode-desc (object-name) + "A function to describe an object." + (interactive (list (read-from-minibuffer "Describe: " ))) + (let ((desc-buffer + (enode-buffer (format "*ENODE-describe-%s*" object-name))) + ) + ;; How are we connected? + ;; Oracle database... + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-desc object-name desc-buffer) + ) + ) + (display-buffer desc-buffer) + (message "Done.") + ) + ) + +(defun enode-list-invalid-objects (dbuser &optional object-type) + "" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser object-type t) + ) + +(defun enode-list-objects (dbuser &optional object-type invalid-flag + filter-string) + "A function to throw up a list of the database objects owned by the specified +DBUSER. +When called interactively, the current user is used." + ;; Who we're currently connected as + (interactive (list (upcase (enode-connected-user)))) + ;; The buffer to send the output to. + (let ((object-list-buffer + (enode-buffer + (format + "*ENODE-%s-%s*" dbuser + (if object-type (format "%ss" (downcase object-type)) "objects") + )) + ) + ) + ;; How are we connected? + ;; Oracle database... + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-list-objects object-list-buffer dbuser object-type + invalid-flag filter-string) + ) + ) + ;; Go to the buffer (again?) + (display-buffer object-list-buffer) + ;; We're Done. + (message "Done.") + ) + ) + +(defun enode-list-object-types (&optional dbuser) + "A function to throw up a list of the object types." + ;; Who we're currently connected as + (interactive) + ;; The buffer to send the output to. + (let ((object-type-list-buffer (enode-buffer "*ENODE-object-types*"))) + ;; How are we connected? + ;; Oracle database... + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-list-object-types object-type-list-buffer dbuser) + ) + ) + ;; Show the buffer + (display-buffer object-type-list-buffer) + ;; We're Done. + (message "Done.") + ) + ) + +(defun enode-list-tables (dbuser) + "A function to throw up a list of the database user's tables" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "TABLE") + ) + +(defun enode-list-tables-filtered (dbuser filter-string) + "A function to throw up a list of the database user's tables" + (interactive (list (upcase (enode-connected-user)) + (upcase (read-from-minibuffer + "Case-insensitive name substring: ") + ) + ) + ) + (enode-list-objects dbuser "TABLE" nil filter-string) + ) + +(defun enode-list-views (dbuser) + "A function to throw up a list of the database user's views" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "VIEW") + ) + +(defun enode-list-materialised-views (dbuser) + "A function to throw up a list of the database user's views" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "MATERIALIZED VIEW") + ) + +(defun enode-list-functions (dbuser) + "A function to throw up a list of the database user's functions" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "FUNCTION") + ) + +(defun enode-list-procedures (dbuser) + "A function to throw up a list of the database user's procedures" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "PROCEDURE") + ) + +(defun enode-list-packages (dbuser) + "A function to throw up a list of the database user's packages" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "PACKAGE") + ) + +(defun enode-list-package-bodies (dbuser) + "A function to throw up a list of the database user's package bodies" + (interactive (list (upcase (enode-connected-user)))) + (enode-list-objects dbuser "PACKAGE BODY") + ) + +;; +;; Internal functions +;; + +(defun enode-project-available (enode-project) + "A function to check whether a project is available. It returns TRUE if +the project's top directory is there AND if the enode file is present." + (and (file-exists-p (format "%s/%s/%s/%s_ENODE.sql" + enode-projects-dir + (car enode-project) + enode-project-sql-file-dir + (car enode-project)))) + ) + +(defun enode-available-projects () + "A function to take the list of ENODE projects and to turn it into a list +of projects that are available." + (let ((the-project-list (enode-get-projects)) + (available-project-list ())) + (while the-project-list + (if (enode-project-available (car the-project-list)) + (setq available-project-list + (append available-project-list (list (car the-project-list)))) + ) + (setq the-project-list (cdr the-project-list)) + ) + available-project-list + ) + ) + +(defun enode-connected-user () + "A function to return the username of the currently connected user" + ;; Get the current connection description + (let ((my-conn (enode-query-connection))) + ;; Locate the username part of it + (string-match "^\\(.+\\)@" my-conn) + ;; Return that part + (substring my-conn (match-beginning 1) (match-end 1)) + ) + ) + +(defun enode-add-new-connection (conn-desc) + "A function to add a new connection to the list of current connections" + ;; Get the list of all the possible connections + (let ((all-connections (enode-load-connections-list)) + ;; Get the list of the connections of the current type. + (current-type-connections (enode-get-connections))) + ;; As long as the description we want to create a connection for doesn't + ;; exist already... + (if (not (assoc conn-desc current-type-connections)) + (progn + ;; Get the username + (setq conn-user + (read-from-minibuffer (format "Username for %s: " conn-desc))) + ;; Get the connection name + (setq conn-connection + (read-from-minibuffer (format "Database for %s: " conn-desc))) + ;; Get the prompt that will be used + (setq conn-prompt + (read-from-minibuffer (format "SQLPROMPT for %s: " conn-desc))) + ;; Add these details to the list of connections for the current type + (setq current-type-connections + (cons (list conn-desc + conn-user + nil + conn-connection + conn-prompt) + current-type-connections)) + ;; Replace the connections for this type in the list of all + ;; connections with the new list for this type. + (setq all-connections (cons (cons enode-current-connection-type + current-type-connections) + (assq-delete-all + enode-current-connection-type + all-connections))) + ;; Open the file that contains the connections + (find-file enode-connections-file) + ;; Go to the start of the file. + (goto-char (point-min)) + ;; Look for where the information is specified + (re-search-forward "^(setq enode-connections") + ;; Remove that command. + (beginning-of-line) + (kill-sexp) + ;; (delete-region (point) (save-excursion (end-of-sexp)(point))) + + ;; Insert a replacement command + (insert (format "(setq enode-connections '%S)" all-connections)) + + ;; Write the file and dismiss the buffer + (save-buffer) + (kill-buffer (current-buffer)) + + ;; Load the new connection information + (enode-load-connections-list) + ) + ) + ) + ) + +(defun enode-get-projects () + "A function to build a list of projects" + ;; If the variable is set already, return it + (if (not enode-projects) + (load-file enode-projects-file)) + enode-projects + ) + +;; Get the list of connections for the current type of connection +(defun enode-get-connections () + "A function to return the list of connections for the current ENODE connection type (as specified in ENODE-CURRENT-CONNECTION-TYPE)." + (if (not enode-connections) + (enode-load-connections-list)) + (cdr (assoc enode-current-connection-type enode-connections)) + ) + +;; Load up the list of connections. +(defun enode-load-connections-list () + "Load the connection information from the file." + (load-file enode-connections-file) + enode-connections + ) + +(defun enode-buffer (buffer-name) + "A generic function for creating and returning a buffer." + ;; Get the buffer + (let ((the-buffer (get-buffer-create buffer-name))) + ;; Empty it + (enode-clean-buffer the-buffer) + ;; Return it + the-buffer + ) + ) + +(defun enode-wait-for-command () + "A function to wait for a comint redirect command to complete" + (save-excursion + (set-buffer sql-buffer) + (while (null comint-redirect-completed) + (message enode-progress-message) + (setq enode-progress-message + (concat enode-progress-message ".")) + (accept-process-output nil 0 1000)))) + +(defun enode-clean-buffer (enode-buffer) + "A function to empty the ENODE-BUFFER." + (save-excursion + (set-buffer enode-buffer) + (erase-buffer) + ) + ) + +(defun enode-code-buffer (code-type &optional code-name code-owner) + "A generic function for creating and returning a buffer for a piece of code." + ;; Get the buffer + (let ((the-buffer + (get-buffer-create + (format "*enode-%S-%s%s*" + enode-current-connection-type + (downcase code-type) + (if code-name + (format "-%s%s" + (if code-owner (format "%s." code-owner) "") + code-name) + "") + ) + ) + ) + ) + ;; Empty it + + (enode-clean-buffer the-buffer) + ;; Return it + the-buffer + ) + ) + +(defun enode-new-project (proj-name) + "A function to set up a new project" + (interactive "sProject name: ") + ;; Raise an error if the project already exists. + (if (assoc proj-name enode-projects) + (error "Project already exists") + ) + ;; Determine the directory for this new project. + (let ((proj-dir (format "%s/%s" enode-projects-dir proj-name))) + ;; If the base SQL directory for the project doesn't exist, create it. + (if (not (file-exists-p (format "%s/%s" proj-dir + enode-project-sql-file-dir))) + (make-directory (format "%s/%s" proj-dir + enode-project-sql-file-dir) t)) + ;; Get the base SQL file for the project. + (find-file (format "%s/%s/%s_ENODE.sql" proj-dir + enode-project-sql-file-dir proj-name)) + ) + ;; Add the new project to the list of maintained projects. + (enode-add-project-to-list proj-name) + ) + +(defun enode-add-project-to-list (proj-name) + "A function to add a project to the list of usable projects" + + ;; If it isn't already set, determine the connection type for this + ;; new project. + (if (not enode-current-connection-type) + (setq enode-current-connection-type + (make-symbol + (read-from-minibuffer + (format + "Please enter a connection type (supported options: %S): " + enode-supported-connection-types + )))) + ) + + ;; Add the project to the active list + (setq enode-projects (cons (list proj-name enode-current-connection-type) + enode-projects)) + (save-excursion + ;; Get the file + (find-file enode-projects-file) + ;; Look for where the information is specified + (re-search-forward "^(setq enode-projects") + ;; Remove that command. + (beginning-of-line) + (kill-sexp) + ;; (delete-region (point) (save-excursion (end-of-sexp) (point))) + ;; Insert a replacement command + (insert (format "(setq enode-projects '%S)" enode-projects)) + ;; Write the file and dismiss the buffer + (save-buffer) + (kill-buffer (current-buffer)) + ) + ) + +(defun enode-rollback () + "A command to rollback a change." + (interactive) + (enode-commit t) + ) + +(defun enode-commit (&optional rollback) + "A command to commit a change to a database" + (interactive) + ;; How are we connected? + ;; Oracle database... + (cond ((eq 'oracle enode-current-connection-type) + (enode-oracle-commit rollback) + ) + ) + ) + +(defun enode-quit () + "A command to exit ENODE" + (interactive) + (let ((my-buffer-list (mapcar 'buffer-name (buffer-list))) + enode-buffer-list + (my-case-fold-search case-fold-search) + user-reply + ) + (setq case-fold-search t) + (while my-buffer-list + (if (or (string-match "enode" (car my-buffer-list)) + (buffer-file-name (get-buffer (car my-buffer-list)))) + (setq enode-buffer-list + (cons (car my-buffer-list) enode-buffer-list)) + ) + (setq my-buffer-list (cdr my-buffer-list)) + ) + (with-temp-buffer + (insert (format "\n\nQuitting ENODE!\n\n")) + (insert (format "%s%s" + "You are about to leave ENODE. This will close the SQL " + "session and then kill the following buffers:\n\n")) + (let ((my-enode-buffer-list enode-buffer-list)) + (while my-enode-buffer-list + (insert (format " %s %s\n" + (if (buffer-modified-p + (get-buffer + (car my-enode-buffer-list))) + "*" + "%") + (car my-enode-buffer-list)) + ) + (setq my-enode-buffer-list (cdr my-enode-buffer-list)) + ) + ) + (insert (format "\n")) + (insert (format "%s%s" + "If you want to keep any of these, say \"no\" now and " + "rename them.")) + (display-buffer (current-buffer)) + (setq user-reply (yes-or-no-p "Are you sure you want to quit ENODE? ")) + ) + (if user-reply + (progn + (enode-stop-engine) + (kill-buffer sql-buffer) + (while enode-buffer-list + (kill-buffer (car enode-buffer-list)) + (setq enode-buffer-list (cdr enode-buffer-list)) + ) + (setq enode-up nil) + (if enode-launched-as-application + (save-buffers-kill-emacs) + ) + ) + ) + ) + ) + +(provide 'enode) diff --git a/enode-lisp/pls-extras.el b/enode-lisp/pls-extras.el new file mode 100755 index 0000000..8040fda --- /dev/null +++ b/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 / 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) diff --git a/enode-lisp/sql-extras.el b/enode-lisp/sql-extras.el new file mode 100755 index 0000000..20d2ec6 --- /dev/null +++ b/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)