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