;; Copyright 2013 Éibhear Ó hAnluain
;; This file is part of ENODE.
;;
;; ENODE is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; ENODE is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with ENODE. If not, see .
(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)