5151 lines
212 KiB
EmacsLisp
5151 lines
212 KiB
EmacsLisp
;;; sqlplus.el --- User friendly interface to SQL*Plus and support for PL/SQL compilation
|
|
|
|
;; Copyright (C) 2007, 2008 Peter Karpiuk, Scott Tiger S.A.
|
|
|
|
;; Author: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com>
|
|
;; Maintainer: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com>
|
|
;; Created: 25 Nov 2007
|
|
;; Version 0.9.0
|
|
;; Keywords: sql sqlplus oracle plsql
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published
|
|
;; by the Free Software Foundation; either version 2, or (at your
|
|
;; option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful, but
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;; General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Facilitates interaction with Oracle via SQL*Plus (GNU Emacs only).
|
|
;; Moreover, this package complements plsql.el (Kahlil Hodgson)
|
|
;; upon convenient compilation of PL/SQL source files.
|
|
;;
|
|
;; This package was inspired by sqlplus-mode.el (Rob Riepel, Peter
|
|
;; D. Pezaris, Martin Schwenke), but offers more features:
|
|
;; - tables are parsed, formatted and rendered with colors, like in
|
|
;; many GUI programs; you can see raw SQL*Plus output also,
|
|
;; if you wish
|
|
;; - table will be cutted if you try to fetch too many rows
|
|
;; (SELECT * FROM MY_MILLION_ROWS_TABLE); current SQL*Plus command
|
|
;; will be automatically interrupted under the hood in such cases
|
|
;; - you can use many SQL*Plus processes simultaneously,
|
|
;; - font locking (especially if you use Emacs>=22), with database
|
|
;; object names highlighting,
|
|
;; - history (log) of executed commands - see` sqlplus-history-dir`
|
|
;; variable,
|
|
;; - commands for fetching any database object definition
|
|
;; (package, table/index/sequence script)
|
|
;; - query result can be shown in HTML,
|
|
;; - input buffer for each connection can be saved into file on
|
|
;; disconnect and automatically restored on next connect (see
|
|
;; 'sqlplus-session-cache-dir' variable); if you place some
|
|
;; SQL*Plus commands between '/* init */' and '/* end */'
|
|
;; comments in saved input buffer, they will be automatically
|
|
;; executed on every connect
|
|
;; - if you use plsql.el for editing PL/SQL files, you can compile
|
|
;; such sources everytime with C-cC-c; error messages will be
|
|
;; parsed and displayed for easy source navigation
|
|
;; - M-. or C-mouse-1 on database object name will go to definition
|
|
;; in filesystem (use arrow button on toolbar to go back)
|
|
;;
|
|
;; The following commands should be added to a global initialization
|
|
;; file or to any user's .emacs file to conveniently use
|
|
;; sqlplus-mode:
|
|
;;
|
|
;; (require 'sqlplus)
|
|
;; (add-to-list 'auto-mode-alist '("\\.sqp\\'" . sqlplus-mode))
|
|
;;
|
|
;; If you want PL/SQL support also, try something like this:
|
|
;;
|
|
;; (require 'plsql)
|
|
;; (setq auto-mode-alist
|
|
;; (append '(("\\.pls\\'" . plsql-mode) ("\\.pkg\\'" . plsql-mode)
|
|
;; ("\\.pks\\'" . plsql-mode) ("\\.pkb\\'" . plsql-mode)
|
|
;; ("\\.sql\\'" . plsql-mode) ("\\.PLS\\'" . plsql-mode)
|
|
;; ("\\.PKG\\'" . plsql-mode) ("\\.PKS\\'" . plsql-mode)
|
|
;; ("\\.PKB\\'" . plsql-mode) ("\\.SQL\\'" . plsql-mode)
|
|
;; ("\\.prc\\'" . plsql-mode) ("\\.fnc\\'" . plsql-mode)
|
|
;; ("\\.trg\\'" . plsql-mode) ("\\.vw\\'" . plsql-mode)
|
|
;; ("\\.PRC\\'" . plsql-mode) ("\\.FNC\\'" . plsql-mode)
|
|
;; ("\\.TRG\\'" . plsql-mode) ("\\.VW\\'" . plsql-mode))
|
|
;; auto-mode-alist ))
|
|
;;
|
|
;; M-x sqlplus will start new SQL*Plus session.
|
|
;;
|
|
;; C-RET execute command under point
|
|
;; S-C-RET execute command under point and show result table in HTML
|
|
;; buffer
|
|
;; M-RET explain execution plan for command under point
|
|
;; M-. or C-mouse-1: find database object definition (table, view
|
|
;; index, synonym, trigger, procedure, function, package)
|
|
;; in filesystem
|
|
;; C-cC-s show database object definition (retrieved from database)
|
|
;;
|
|
;; Use describe-mode while in sqlplus-mode for further instructions.
|
|
;;
|
|
;; Many useful commands are defined in orcl-mode minor mode, which is
|
|
;; common for input and otput SQL*Plus buffers, as well as PL/SQL
|
|
;; buffers.
|
|
;;
|
|
;; For twiddling, see 'sqlplus' customization group.
|
|
;;
|
|
;; If you find this package useful, send me a postcard to address:
|
|
;;
|
|
;; Peter Karpiuk
|
|
;; Scott Tiger S.A.
|
|
;; ul. Gawinskiego 8
|
|
;; 01-645 Warsaw
|
|
;; Poland
|
|
|
|
;;; Known bugs:
|
|
|
|
;; 1. Result of SQL select command can be messed up if some columns
|
|
;; has newline characters. To avoid this, execute SQL*Plus command
|
|
;; column <colname> truncated
|
|
;; before such select
|
|
|
|
;;; Code:
|
|
|
|
(require 'recentf)
|
|
(require 'font-lock)
|
|
(require 'cl)
|
|
(require 'sql)
|
|
(require 'tabify)
|
|
(require 'skeleton)
|
|
|
|
(defconst sqlplus-revision "$Revision: 1.7 $")
|
|
|
|
;;; Variables -
|
|
|
|
(defgroup sqlplus nil
|
|
"SQL*Plus"
|
|
:group 'tools
|
|
:version 21)
|
|
|
|
(defcustom plsql-auto-parse-errors-flag t
|
|
"Non nil means parse PL/SQL compilation results and show them in the compilation buffer."
|
|
:group 'sqlplus
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-init-sequence-start-regexp "/\\* init \\*/"
|
|
"SQL*Plus start of session init command sequence."
|
|
:group 'sqlplus
|
|
:type '(regexp))
|
|
|
|
(defcustom sqlplus-init-sequence-end-regexp "/\\* end \\*/"
|
|
"SQL*Plus end of session init command sequence."
|
|
:group 'sqlplus
|
|
:type '(regexp))
|
|
|
|
(defcustom sqlplus-explain-plan-warning-regexps '("TABLE ACCESS FULL" "INDEX FULL SCAN")
|
|
"SQL*Plus explain plan warning regexps"
|
|
:group 'sqlplus
|
|
:type '(repeat regexp))
|
|
|
|
(defcustom sqlplus-syntax-faces
|
|
'((schema font-lock-type-face nil)
|
|
(table font-lock-type-face ("dual"))
|
|
(synonym font-lock-type-face nil)
|
|
(view font-lock-type-face nil)
|
|
(column font-lock-constant-face nil)
|
|
(sequence font-lock-type-face nil)
|
|
(package font-lock-type-face nil)
|
|
(trigger font-lock-type-face nil)
|
|
(index font-lock-type-face) nil)
|
|
"Font lock configuration for database object names in current schema.
|
|
This is alist, and each element looks like (SYMBOL FACE LIST)
|
|
where SYMBOL is one of: schema, table, synonym, view, column,
|
|
sequence, package, trigger, index. Database objects means only
|
|
objects from current schema, so if you want syntax highlighting
|
|
for other objects (eg. 'dual' table name), you can explicitly
|
|
enumerate them in LIST as strings."
|
|
:group 'sqlplus
|
|
:tag "Oracle SQL Syntax Faces"
|
|
:type '(repeat (list symbol face (repeat string))))
|
|
|
|
(defcustom sqlplus-output-buffer-max-size (* 50 1000 1000)
|
|
"Maximum size of SQL*Plus output buffer.
|
|
After exceeding oldest results are deleted."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Output Buffer Max Size"
|
|
:type '(integer))
|
|
|
|
(defcustom sqlplus-select-result-max-col-width nil
|
|
"Maximum width of column in displayed database table, or nil if there is no limit.
|
|
If any cell value is longer, it will be cutted and terminated with ellipsis ('...')."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Select Result Max Column Width"
|
|
:type '(choice integer (const nil)))
|
|
|
|
(defcustom sqlplus-format-output-tables-flag t
|
|
"Non-nil means format result if it looks like database table."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Format Output Table"
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-kill-processes-without-query-on-exit-flag t
|
|
"Non-nil means silently kill all SQL*Plus processes on Emacs exit."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Kill Processes Without Query On Exit"
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-multi-output-tables-default-flag t
|
|
"Non-nil means render database table as set of adjacent tables so that they occupy all width of output window.
|
|
For screen space saving and user comfort."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Multiple Tables In Output by Default"
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-source-buffer-readonly-by-default-flag t
|
|
"Non-nil means show database sources in read-only buffer."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Source Buffer Read Only By Default"
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-command "sqlplus"
|
|
"SQL*Plus interpreter program."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Command"
|
|
:type '(string))
|
|
|
|
(defcustom sqlplus-history-dir nil
|
|
"Directory of SQL*Plus command history (log) files, or nil (dont generate log files).
|
|
History file name has format '<connect-string>-history.txt'."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus History Dir"
|
|
:type '(choice directory (const nil)))
|
|
|
|
(defvar sqlplus-session-file-extension "sqp")
|
|
|
|
(defcustom sqlplus-session-cache-dir nil
|
|
"Directory of SQL*Plus input buffer files, or nil (dont save user session).
|
|
Session file name has format '<connect-string>.sqp'"
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus History Dir"
|
|
:type '(choice directory (const nil)))
|
|
|
|
(defcustom sqlplus-save-passwords nil
|
|
"Non-nil means save passwords between Emacs sessions. (Not implemented yet)."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Save Passwords"
|
|
:type '(boolean))
|
|
|
|
(defcustom sqlplus-pagesize 200
|
|
"Approximate number of records in query results.
|
|
If result has more rows, it will be cutted and terminated with '. . .' line."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Max Rows Count"
|
|
:type '(integer))
|
|
|
|
(defvar sqlplus-default-wrap "on")
|
|
|
|
(defcustom sqlplus-initial-strings
|
|
(list "set sqlnumber off"
|
|
"set tab off"
|
|
"set linesize 4000"
|
|
"set echo off"
|
|
"set newpage 1"
|
|
"set space 1"
|
|
"set feedback 6"
|
|
"set heading on"
|
|
"set trimspool off"
|
|
(format "set wrap %s" sqlplus-default-wrap)
|
|
"set timing on"
|
|
"set feedback on")
|
|
"Initial commands to send to interpreter.
|
|
Customizing this variable is dangerous."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Initial Strings"
|
|
:type '(repeat string))
|
|
|
|
(defcustom sqlplus-table-col-separator " | "
|
|
"Database table column separator (text-only terminals)."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Table Col Separator"
|
|
:type '(string))
|
|
|
|
(defcustom sqlplus-table-col-head-separator "-+-"
|
|
"Database table header-column separator (text-only terminals)."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus Table Col Separator"
|
|
:type '(string))
|
|
|
|
(defcustom sqlplus-html-output-file-name "$HOME/sqlplus_report.html"
|
|
"Output file for HTML result."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus HTML Output File Name"
|
|
:type '(file))
|
|
|
|
(defcustom sqlplus-html-output-encoding "iso-8859-1"
|
|
"Encoding for SQL*Plus HTML output."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus HTML Output Encoding"
|
|
:type '(string))
|
|
|
|
(defcustom sqlplus-html-output-sql t
|
|
"Non-nil means put SQL*Plus command in head of HTML result."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus HTML Output Encoding"
|
|
:type '(choice (const :tag "Elegant" 'elegant)
|
|
(const :tag "Simple" t)
|
|
(const :tag "No" nil)))
|
|
|
|
(defcustom sqlplus-html-output-header (concat (current-time-string) "<br><br>")
|
|
"HTML header sexp (result must be string)."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus HTML Output Header"
|
|
:type '(sexp))
|
|
|
|
(defcustom sqlplus-command-highlighting-percentage 7
|
|
"SQL*Plus command highlighting percentage (0-100), only if sqlplus-command-highlighting-style is set."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plus command highlighting percentage"
|
|
:type '(integer))
|
|
|
|
(defcustom sqlplus-command-highlighting-style nil
|
|
"How to highlight current command in sqlplus buffer."
|
|
:group 'sqlplus
|
|
:tag "SQL*Plud command highlighting style"
|
|
:type '(choice (const :tag "Fringe" fringe)
|
|
(const :tag "Background" background)
|
|
(const :tag "Fringe and background" fringe-and-background)
|
|
(const :tag "None" nil)))
|
|
|
|
(defvar sqlplus-elegant-style window-system)
|
|
|
|
(defvar sqlplus-cs nil)
|
|
|
|
(defun sqlplus-shine-color (color percent)
|
|
(when (equal color "unspecified-bg")
|
|
(setq color (if (< percent 0) "white" "black")))
|
|
(apply 'format "#%02x%02x%02x"
|
|
(mapcar (lambda (value)
|
|
(min 65535 (max 0 (* (+ (/ value 650) percent) 650))))
|
|
(color-values color))))
|
|
|
|
(defvar sqlplus-table-head-face 'sqlplus-table-head-face)
|
|
(defface sqlplus-table-head-face
|
|
(list
|
|
(list '((class mono))
|
|
'(:inherit default :weight bold :inverse-video t))
|
|
(list '((background light))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -70) :foreground (face-background 'default))
|
|
(when (and sqlplus-elegant-style (>= emacs-major-version 22)) '(:box (:style released-button)))))
|
|
(list '((background dark))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +70) :foreground (face-background 'default))
|
|
(when (and sqlplus-elegant-style (>= emacs-major-version 22)) '(:box (:style released-button)))))
|
|
'(t (:inherit default)))
|
|
"Face for table header"
|
|
:group 'sqlplus)
|
|
|
|
(defvar sqlplus-table-even-rows-face 'sqlplus-table-even-rows-face)
|
|
(defface sqlplus-table-even-rows-face
|
|
(list
|
|
(list '((class mono)) '())
|
|
(list '((type tty)) '())
|
|
(list '((background light))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -20) :overline (face-background 'default))))
|
|
(list '((background dark))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +20) :overline (face-background 'default))))
|
|
'(t ()))
|
|
"Face for table even rows"
|
|
:group 'sqlplus)
|
|
|
|
(defvar sqlplus-table-odd-rows-face 'sqlplus-table-odd-rows-face)
|
|
(defface sqlplus-table-odd-rows-face
|
|
(list
|
|
(list '((class mono)) '(:inherit default))
|
|
(list '((background light))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) -30) :overline (face-background 'default))))
|
|
(list '((background dark))
|
|
(append (list :inherit 'default :background (sqlplus-shine-color (face-background 'default) +30) :overline (face-background 'default))))
|
|
'(t (:inherit default)))
|
|
"Face for table even rows"
|
|
:group 'sqlplus)
|
|
|
|
(defvar sqlplus-command-highlight-face 'sqlplus-command-highlight-face)
|
|
(defface sqlplus-command-highlight-face
|
|
(list
|
|
'(((class mono)) ())
|
|
'(((type tty)) ())
|
|
(list '((background light))
|
|
(append (list :background (sqlplus-shine-color (face-background 'default) (- sqlplus-command-highlighting-percentage)))))
|
|
(list '((background dark))
|
|
(append (list :background (sqlplus-shine-color (face-background 'default) sqlplus-command-highlighting-percentage))))
|
|
'(t ()))
|
|
"Face for highlighting command under point"
|
|
:group 'sqlplus)
|
|
|
|
(defvar sqlplus-plsql-compilation-results-buffer-name "*PL/SQL Compilation*")
|
|
|
|
(defvar sqlplus-fan "|"
|
|
"Local in input buffers")
|
|
(make-variable-buffer-local 'sqlplus-fan)
|
|
|
|
(defvar orcl-mode-map nil
|
|
"Keymap used in Orcl mode.")
|
|
|
|
(define-minor-mode orcl-mode
|
|
"Mode for executing SQL*Plus commands and scrolling results.
|
|
|
|
Mode Specific Bindings:
|
|
|
|
\\{orcl-mode-map}"
|
|
nil ; init value
|
|
(" " (:eval sqlplus-fan) " " (:eval (connect-string-to-string))) ; mode indicator
|
|
orcl-mode-map ; keymap
|
|
;; body
|
|
(setq sqlplus-fan "|")
|
|
(unless (assq 'orcl-mode minor-mode-map-alist)
|
|
(push (cons 'orcl-mode orcl-mode-map) minor-mode-map-alist)))
|
|
|
|
(defvar sqlplus-user-variables (makehash 'equal))
|
|
|
|
(defvar sqlplus-user-variables-history nil)
|
|
|
|
(defvar sqlplus-get-source-history nil)
|
|
|
|
(defvar sqlplus-process-p nil
|
|
"Non-nil (connect string) if current buffer is SQL*Plus process buffer.
|
|
Local in process buffer.")
|
|
(make-variable-buffer-local 'sqlplus-process-p)
|
|
|
|
(defvar sqlplus-command-seq 0
|
|
"Sequence for command id within SQL*Plus connection.
|
|
Local in process buffer.")
|
|
(make-variable-buffer-local 'sqlplus-command-seq)
|
|
|
|
;;; :id - unique command identifier (from sequence, for session)
|
|
;;; :sql - content of command
|
|
;;; :dont-parse-result - process data online as it comes from sqlplus, with sqlplus-result-online or with :result-function function
|
|
;;; :result-function - function for processing sqlplus data; must have signature (context connect-string begin end interrupted);
|
|
;;; if nil then it is sqlplus-result-online for :dont-parse-result set to non-nil and sqlplus-process-command-output for :dont-parse-result set to nil
|
|
;;; :current-command-input-buffer-name - buffer name from which command was initialized
|
|
(defvar sqlplus-command-contexts nil
|
|
"Command options list, for current and enqueued commands, in chronological order.
|
|
Local in process buffer.")
|
|
(make-variable-buffer-local 'sqlplus-command-contexts)
|
|
|
|
(defvar sqlplus-connect-string nil
|
|
"Local variable with connect-string for current buffer (input buffers, output buffer).")
|
|
(make-variable-buffer-local 'sqlplus-connect-string)
|
|
|
|
(defvar sqlplus-connect-strings-alist nil
|
|
"Connect strings in format (CS . PASSWD), where PASSWD can be nil.")
|
|
|
|
(defvar sqlplus-connect-string-history nil)
|
|
|
|
(defvar sqlplus-prompt-prefix "SQL[")
|
|
(defvar sqlplus-prompt-suffix "]# ")
|
|
|
|
(defvar sqlplus-page-separator "@!%#!")
|
|
|
|
(defvar sqlplus-repfooter "##%@!")
|
|
|
|
(defvar sqlplus-mode-map nil
|
|
"Keymap used in SQL*Plus mode.")
|
|
|
|
(defvar sqlplus-output-separator "@--"
|
|
"String printed between sets of SQL*Plus command output.")
|
|
|
|
;;; Markers -
|
|
|
|
(defvar sqlplus-buffer-mark (make-marker)
|
|
"Marks the current SQL command in the SQL*Plus output buffer.
|
|
Local in output buffer.")
|
|
(make-variable-buffer-local 'sqlplus-buffer-mark)
|
|
|
|
(defvar sqlplus-region-beginning-pos nil
|
|
"Marks the beginning of the region to sent to the SQL*Plus process.
|
|
Local in input buffer with sqlplus-mode.")
|
|
(make-variable-buffer-local 'sqlplus-region-beginning-pos)
|
|
|
|
(defvar sqlplus-region-end-pos nil
|
|
"Marks the end of the region to sent to the SQL*Plus process.
|
|
Local in input buffer with sqlplus-mode.")
|
|
(make-variable-buffer-local 'sqlplus-region-end-pos)
|
|
|
|
(defvar sqlplus-connections-menu
|
|
'("SQL*Plus"
|
|
:filter sqlplus-connections-menu)
|
|
"Menu for database connections")
|
|
|
|
(defconst sqlplus-kill-xpm "\
|
|
/* XPM */
|
|
static char * reload_page_xpm[] = {
|
|
\"24 24 100 2\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #2A5695\",
|
|
\"@ c #30609E\",
|
|
\"# c #3363A2\",
|
|
\"$ c #3969A6\",
|
|
\"% c #3D6BA6\",
|
|
\"& c #3C68A3\",
|
|
\"* c #35619C\",
|
|
\"= c #244F8D\",
|
|
\"- c #3364A3\",
|
|
\"; c #3162A1\",
|
|
\"> c #3867A4\",
|
|
\", c #3F6DA8\",
|
|
\"' c #4672AC\",
|
|
\") c #4B76AE\",
|
|
\"! c #4E78AF\",
|
|
\"~ c #537CB1\",
|
|
\"{ c #547DB0\",
|
|
\"] c #446BA1\",
|
|
\"^ c #2E5D9C\",
|
|
\"/ c #234F8C\",
|
|
\"( c #214C89\",
|
|
\"_ c #244E8C\",
|
|
\": c #3A649D\",
|
|
\"< c #517BB0\",
|
|
\"[ c #517BB1\",
|
|
\"} c #4874AD\",
|
|
\"| c #6086B7\",
|
|
\"1 c #5F84B4\",
|
|
\"2 c #4B71A6\",
|
|
\"3 c #7B9BC4\",
|
|
\"4 c #224C89\",
|
|
\"5 c #3865A2\",
|
|
\"6 c #406FAB\",
|
|
\"7 c #436BA3\",
|
|
\"8 c #648ABA\",
|
|
\"9 c #4D78AF\",
|
|
\"0 c #4B77AE\",
|
|
\"a c #6E91BE\",
|
|
\"b c #809EC6\",
|
|
\"c c #204A87\",
|
|
\"d c #4974AF\",
|
|
\"e c #2B5590\",
|
|
\"f c #6487B5\",
|
|
\"g c #678CBB\",
|
|
\"h c #3465A4\",
|
|
\"i c #84A1C8\",
|
|
\"j c #6D8FBA\",
|
|
\"k c #4F7AB0\",
|
|
\"l c #8BA7CB\",
|
|
\"m c #7E9DC5\",
|
|
\"n c #83A1C7\",
|
|
\"o c #91ACCE\",
|
|
\"p c #89A4C9\",
|
|
\"q c #8FA9CB\",
|
|
\"r c #85A2C7\",
|
|
\"s c #90ABCC\",
|
|
\"t c #3E6CA8\",
|
|
\"u c #87A3C8\",
|
|
\"v c #4B6DA1\",
|
|
\"w c #91ABCD\",
|
|
\"x c #3768A5\",
|
|
\"y c #8AA5C9\",
|
|
\"z c #2D5690\",
|
|
\"A c #204A86\",
|
|
\"B c #93ADCE\",
|
|
\"C c #7294BF\",
|
|
\"D c #6288B9\",
|
|
\"E c #86A3C8\",
|
|
\"F c #466EA3\",
|
|
\"G c #3864A1\",
|
|
\"H c #285390\",
|
|
\"I c #234E8C\",
|
|
\"J c #95AECF\",
|
|
\"K c #7493BC\",
|
|
\"L c #86A2C7\",
|
|
\"M c #7999C3\",
|
|
\"N c #5B82B5\",
|
|
\"O c #6C8EBB\",
|
|
\"P c #4B71A5\",
|
|
\"Q c #26508B\",
|
|
\"R c #2B5792\",
|
|
\"S c #305E9B\",
|
|
\"T c #31619F\",
|
|
\"U c #7895BD\",
|
|
\"V c #819DC3\",
|
|
\"W c #688DBB\",
|
|
\"X c #6288B8\",
|
|
\"Y c #5880B4\",
|
|
\"Z c #577FB3\",
|
|
\"` c #547DB2\",
|
|
\" . c #416FAA\",
|
|
\".. c #3564A2\",
|
|
\"+. c #577AAB\",
|
|
\"@. c #6286B6\",
|
|
\"#. c #668BBA\",
|
|
\"$. c #507AB0\",
|
|
\"%. c #426EA8\",
|
|
\"&. c #2F5B97\",
|
|
\" \",
|
|
\" \",
|
|
\" \",
|
|
\" . . . . . . . . \",
|
|
\" . . + @ # $ % & * . . . . \",
|
|
\" . = - ; @ > , ' ) ! ~ { . . . ] . \",
|
|
\" . ^ / ( _ . . . : < [ } | 1 2 3 . \",
|
|
\" . _ 4 5 6 . . . 7 8 9 0 a b . \",
|
|
\" . c d . . . e f g h i . \",
|
|
\" . . . . . j k h l . \",
|
|
\" . . f m n l o . \",
|
|
\" . . . . . . . . \",
|
|
\" . . . . . . . . \",
|
|
\" . p q q q r . . \",
|
|
\" . s , t u v . . . . \",
|
|
\" . w x | y z . . . . A . \",
|
|
\" . B C 9 D E F . . . G H I . \",
|
|
\" . J K L M N C O P . . . Q R S T . \",
|
|
\" . U . . . V W X | Y Z ` ) .... \",
|
|
\" . . . . +.@.#.N $.%.&.. . \",
|
|
\" . . . . . . . . \",
|
|
\" \",
|
|
\" \",
|
|
\" \"};
|
|
"
|
|
"XPM format image used as Kill icon")
|
|
|
|
(defconst sqlplus-cancel-xpm "\
|
|
/* XPM */
|
|
static char * process_stop_xpm[] = {
|
|
\"24 24 197 2\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #C92B1E\",
|
|
\"@ c #DA432F\",
|
|
\"# c #E95941\",
|
|
\"$ c #F26B50\",
|
|
\"% c #ED6047\",
|
|
\"& c #DF4A35\",
|
|
\"* c #CE3324\",
|
|
\"= c #BF1D13\",
|
|
\"- c #EA5942\",
|
|
\"; c #EF563A\",
|
|
\"> c #F14D2C\",
|
|
\", c #F1431F\",
|
|
\"' c #F23A12\",
|
|
\") c #F2421C\",
|
|
\"! c #F24D2A\",
|
|
\"~ c #F15737\",
|
|
\"{ c #F0644A\",
|
|
\"] c #CF3121\",
|
|
\"^ c #D83828\",
|
|
\"/ c #ED5840\",
|
|
\"( c #EC3B1C\",
|
|
\"_ c #EE310B\",
|
|
\": c #F1350C\",
|
|
\"< c #F4380D\",
|
|
\"[ c #F53A0D\",
|
|
\"} c #F53B0D\",
|
|
\"| c #F4390D\",
|
|
\"1 c #F2360C\",
|
|
\"2 c #EF3A15\",
|
|
\"3 c #F05A3D\",
|
|
\"4 c #E44D37\",
|
|
\"5 c #CD2B1E\",
|
|
\"6 c #EA4D35\",
|
|
\"7 c #E92D0C\",
|
|
\"8 c #ED2F0B\",
|
|
\"9 c #F0330C\",
|
|
\"0 c #F3380D\",
|
|
\"a c #F63C0E\",
|
|
\"b c #F93F0F\",
|
|
\"c c #F9400F\",
|
|
\"d c #F73D0E\",
|
|
\"e c #F1340C\",
|
|
\"f c #EE300B\",
|
|
\"g c #EC482C\",
|
|
\"h c #E04532\",
|
|
\"i c #E84E3A\",
|
|
\"j c #E62A0E\",
|
|
\"k c #EA2B0A\",
|
|
\"l c #F83F0E\",
|
|
\"m c #FC4310\",
|
|
\"n c #FC4410\",
|
|
\"o c #F63B0E\",
|
|
\"p c #EB2C0A\",
|
|
\"q c #EB5139\",
|
|
\"r c #C8251A\",
|
|
\"s c #DD3D2E\",
|
|
\"t c #E5341D\",
|
|
\"u c #E62508\",
|
|
\"v c #F9BEB2\",
|
|
\"w c #FBCFC5\",
|
|
\"x c #F54C23\",
|
|
\"y c #F95125\",
|
|
\"z c #FDD4CB\",
|
|
\"A c #FABFB2\",
|
|
\"B c #E83013\",
|
|
\"C c #E84F3B\",
|
|
\"D c #E54737\",
|
|
\"E c #E22007\",
|
|
\"F c #E92A09\",
|
|
\"G c #FBD2CA\",
|
|
\"H c #FFFFFF\",
|
|
\"I c #FDDFD9\",
|
|
\"J c #F64E24\",
|
|
\"K c #FDE0D9\",
|
|
\"L c #E72609\",
|
|
\"M c #E7452F\",
|
|
\"N c #E33D2D\",
|
|
\"O c #E11E07\",
|
|
\"P c #E52308\",
|
|
\"Q c #E82809\",
|
|
\"R c #EC3F21\",
|
|
\"S c #FCDED8\",
|
|
\"T c #F55C37\",
|
|
\"U c #FCDFD8\",
|
|
\"V c #F04521\",
|
|
\"W c #EC2E0A\",
|
|
\"X c #E92909\",
|
|
\"Y c #E62408\",
|
|
\"Z c #E53823\",
|
|
\"` c #CE2B1F\",
|
|
\" . c #C62018\",
|
|
\".. c #E03120\",
|
|
\"+. c #E01C06\",
|
|
\"@. c #E32107\",
|
|
\"#. c #ED4121\",
|
|
\"$. c #FEF9F8\",
|
|
\"%. c #E72709\",
|
|
\"&. c #E42208\",
|
|
\"*. c #E32D17\",
|
|
\"=. c #D83729\",
|
|
\"-. c #CB231B\",
|
|
\";. c #DE2A1B\",
|
|
\">. c #DE1A06\",
|
|
\",. c #EE5135\",
|
|
\"'. c #EF5335\",
|
|
\"). c #EC2D0A\",
|
|
\"!. c #E82709\",
|
|
\"~. c #E21F07\",
|
|
\"{. c #E02511\",
|
|
\"]. c #DC392C\",
|
|
\"^. c #BE1612\",
|
|
\"/. c #DD2E21\",
|
|
\"(. c #DC1705\",
|
|
\"_. c #DF1B06\",
|
|
\":. c #E42308\",
|
|
\"<. c #E93A20\",
|
|
\"[. c #FBDDD8\",
|
|
\"}. c #EB3D20\",
|
|
\"|. c #DF2A18\",
|
|
\"1. c #D02A1F\",
|
|
\"2. c #DC3328\",
|
|
\"3. c #DA1404\",
|
|
\"4. c #DD1805\",
|
|
\"5. c #E3331E\",
|
|
\"6. c #FADCD8\",
|
|
\"7. c #FBDCD8\",
|
|
\"8. c #EB4C34\",
|
|
\"9. c #E6361F\",
|
|
\"0. c #DD1905\",
|
|
\"a. c #DF2F21\",
|
|
\"b. c #C21A14\",
|
|
\"c. c #DA3128\",
|
|
\"d. c #D81408\",
|
|
\"e. c #F7C9C4\",
|
|
\"f. c #FADBD8\",
|
|
\"g. c #E5341E\",
|
|
\"h. c #E5351E\",
|
|
\"i. c #F8CEC9\",
|
|
\"j. c #DB1505\",
|
|
\"k. c #DD3429\",
|
|
\"l. c #C31613\",
|
|
\"m. c #D9281F\",
|
|
\"n. c #D71003\",
|
|
\"o. c #D91304\",
|
|
\"p. c #F3B5B0\",
|
|
\"q. c #F7CDC9\",
|
|
\"r. c #E12F1D\",
|
|
\"s. c #DF1C06\",
|
|
\"t. c #E2301D\",
|
|
\"u. c #F4B6B0\",
|
|
\"v. c #DC1605\",
|
|
\"w. c #DB2317\",
|
|
\"x. c #D2271F\",
|
|
\"y. c #D1231D\",
|
|
\"z. c #D61A10\",
|
|
\"A. c #D60F03\",
|
|
\"B. c #D81104\",
|
|
\"C. c #DB1605\",
|
|
\"D. c #D81204\",
|
|
\"E. c #D81509\",
|
|
\"F. c #DA2F26\",
|
|
\"G. c #D52620\",
|
|
\"H. c #D51A12\",
|
|
\"I. c #D50D03\",
|
|
\"J. c #D60E03\",
|
|
\"K. c #D6170D\",
|
|
\"L. c #D92B23\",
|
|
\"M. c #BD100D\",
|
|
\"N. c #AB0404\",
|
|
\"O. c #CE1D19\",
|
|
\"P. c #D6231C\",
|
|
\"Q. c #D41008\",
|
|
\"R. c #D40B02\",
|
|
\"S. c #D40C02\",
|
|
\"T. c #D50C03\",
|
|
\"U. c #D40E05\",
|
|
\"V. c #D62018\",
|
|
\"W. c #D4251F\",
|
|
\"X. c #B30A09\",
|
|
\"Y. c #A20000\",
|
|
\"Z. c #BC0F0E\",
|
|
\"`. c #D2211E\",
|
|
\" + c #D52520\",
|
|
\".+ c #D5201A\",
|
|
\"++ c #D41A14\",
|
|
\"@+ c #D51F19\",
|
|
\"#+ c #D62620\",
|
|
\"$+ c #D52420\",
|
|
\"%+ c #C51614\",
|
|
\"&+ c #A30101\",
|
|
\"*+ c #A30303\",
|
|
\"=+ c #AE0909\",
|
|
\"-+ c #BD0E0E\",
|
|
\";+ c #B30B0B\",
|
|
\">+ c #A30404\",
|
|
\" \",
|
|
\" . . . . . . . \",
|
|
\" . . + @ # $ % & * . . \",
|
|
\" . = - ; > , ' ) ! ~ { ] . \",
|
|
\" . ^ / ( _ : < [ } | 1 2 3 4 . \",
|
|
\" . 5 6 7 8 9 0 a b c d | e f g h . \",
|
|
\" . i j k f : [ l m n c o 1 _ p q r . \",
|
|
\" . s t u k v w x l m n y z A _ p B C . \",
|
|
\" . D E u F G H I J b y K H w f k L M . \",
|
|
\" . N O P Q R S H I T K H U V W X Y Z ` . \",
|
|
\" . ...+.@.u F #.S H $.H U V 8 k %.&.*.=.. \",
|
|
\" . -.;.>.O &.L F ,.$.H $.'.).k !.P ~.{.].. \",
|
|
\" . ^./.(._.~.:.<.[.H $.H [.}.L P E +.|.1.. \",
|
|
\" . 2.3.4._.5.6.H 7.8.7.H 6.9.~.+.0.a.b.. \",
|
|
\" . c.d.3.(.e.H f.g.@.h.6.H i._.4.j.k.. \",
|
|
\" . l.m.n.o.p.q.r._.s.s.t.e.u.v.3.w.x.. \",
|
|
\" . y.z.A.B.o.j.C.(.(.v.j.3.D.E.F.. \",
|
|
\" . G.H.I.J.n.B.B.B.B.n.A.K.L.M.. \",
|
|
\" . N.O.P.Q.R.S.T.T.S.U.V.W.X.. \",
|
|
\" . Y.Z.`. +.+++@+#+$+%+&+. \",
|
|
\" . . . *+=+-+;+>+Y.. . \",
|
|
\" . . . . . . \",
|
|
\" \",
|
|
\" \"};
|
|
"
|
|
"XPM format image used as Cancel icon")
|
|
|
|
(defconst sqlplus-rollback-xpm "\
|
|
/* XPM */
|
|
static char * rollback_xpm[] = {
|
|
\"24 24 228 2\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #F8F080\",
|
|
\"@ c #FEF57B\",
|
|
\"# c #FFF571\",
|
|
\"$ c #FFF164\",
|
|
\"% c #FFED58\",
|
|
\"& c #FFE748\",
|
|
\"* c #FEDE39\",
|
|
\"= c #F8F897\",
|
|
\"- c #FFFE96\",
|
|
\"; c #FFFA8A\",
|
|
\"> c #FFF67C\",
|
|
\", c #FFF16E\",
|
|
\"' c #FFEC62\",
|
|
\") c #FFE956\",
|
|
\"! c #FFE448\",
|
|
\"~ c #FFE03C\",
|
|
\"{ c #FFDD30\",
|
|
\"] c #FED821\",
|
|
\"^ c #F1CB15\",
|
|
\"/ c #FFFC92\",
|
|
\"( c #FFFC91\",
|
|
\"_ c #FFFC90\",
|
|
\": c #FFFB8D\",
|
|
\"< c #FFF67D\",
|
|
\"[ c #FFEB5E\",
|
|
\"} c #FFEA5B\",
|
|
\"| c #FFE958\",
|
|
\"1 c #FFE855\",
|
|
\"2 c #FFE752\",
|
|
\"3 c #FDD41C\",
|
|
\"4 c #FDD319\",
|
|
\"5 c #FDD416\",
|
|
\"6 c #FFFF9D\",
|
|
\"7 c #FFFF99\",
|
|
\"8 c #FFFD94\",
|
|
\"9 c #FFFA89\",
|
|
\"0 c #FFDC2F\",
|
|
\"a c #FED315\",
|
|
\"b c #FFD808\",
|
|
\"c c #FFFC9F\",
|
|
\"d c #FFFE99\",
|
|
\"e c #FFDF3B\",
|
|
\"f c #F7C909\",
|
|
\"g c #F8EA86\",
|
|
\"h c #FEFCB7\",
|
|
\"i c #FFFDA6\",
|
|
\"j c #FFFA91\",
|
|
\"k c #FFF681\",
|
|
\"l c #FFF171\",
|
|
\"m c #FFED64\",
|
|
\"n c #FFE44A\",
|
|
\"o c #FFE03D\",
|
|
\"p c #FEDB2F\",
|
|
\"q c #F9D21E\",
|
|
\"r c #E9BC0F\",
|
|
\"s c #CE9C02\",
|
|
\"t c #F3E36A\",
|
|
\"u c #FCF899\",
|
|
\"v c #FFFCA3\",
|
|
\"w c #FEF694\",
|
|
\"x c #FFF284\",
|
|
\"y c #FFEE71\",
|
|
\"z c #FFEA62\",
|
|
\"A c #FDDC40\",
|
|
\"B c #F8D22F\",
|
|
\"C c #F1C61B\",
|
|
\"D c #DDAD0A\",
|
|
\"E c #CC9A02\",
|
|
\"F c #C89500\",
|
|
\"G c #F4EA77\",
|
|
\"H c #F7EF7F\",
|
|
\"I c #FFF16A\",
|
|
\"J c #FFEF68\",
|
|
\"K c #FFEE66\",
|
|
\"L c #FED622\",
|
|
\"M c #FED51E\",
|
|
\"N c #FED419\",
|
|
\"O c #E9B90E\",
|
|
\"P c #E7B509\",
|
|
\"Q c #D4A202\",
|
|
\"R c #CA9700\",
|
|
\"S c #F6E67C\",
|
|
\"T c #F3E67F\",
|
|
\"U c #FCEE7A\",
|
|
\"V c #FDEB66\",
|
|
\"W c #FEE44E\",
|
|
\"X c #FED313\",
|
|
\"Y c #FDCA03\",
|
|
\"Z c #F2BE01\",
|
|
\"` c #D4A60D\",
|
|
\" . c #D4A206\",
|
|
\".. c #D19C00\",
|
|
\"+. c #CF9800\",
|
|
\"@. c #E3AF02\",
|
|
\"#. c #F9EB81\",
|
|
\"$. c #FBF096\",
|
|
\"%. c #F9E67C\",
|
|
\"&. c #F8DC5F\",
|
|
\"*. c #F8D548\",
|
|
\"=. c #F9D02D\",
|
|
\"-. c #F9C915\",
|
|
\";. c #F7C104\",
|
|
\">. c #EEB606\",
|
|
\",. c #E9B704\",
|
|
\"'. c #DEAE08\",
|
|
\"). c #414D7B\",
|
|
\"!. c #3C5CA2\",
|
|
\"~. c #3A65B3\",
|
|
\"{. c #3668BB\",
|
|
\"]. c #325EAF\",
|
|
\"^. c #F3E46E\",
|
|
\"/. c #FCFA9B\",
|
|
\"(. c #FFF89C\",
|
|
\"_. c #FDEC81\",
|
|
\":. c #FCE668\",
|
|
\"<. c #FDDF4E\",
|
|
\"[. c #FCDA3C\",
|
|
\"}. c #FCD52E\",
|
|
\"|. c #FAD026\",
|
|
\"1. c #4662A2\",
|
|
\"2. c #465A8D\",
|
|
\"3. c #3F6CBA\",
|
|
\"4. c #3A68B7\",
|
|
\"5. c #2E529E\",
|
|
\"6. c #2655AC\",
|
|
\"7. c #F0DC69\",
|
|
\"8. c #FBF78C\",
|
|
\"9. c #FFF880\",
|
|
\"0. c #FFF06B\",
|
|
\"a. c #FFE03E\",
|
|
\"b. c #FFD828\",
|
|
\"c. c #FED015\",
|
|
\"d. c #F5C40A\",
|
|
\"e. c #4B70B4\",
|
|
\"f. c #4870B7\",
|
|
\"g. c #3C5CA1\",
|
|
\"h. c #4070BF\",
|
|
\"i. c #3759A0\",
|
|
\"j. c #1D469C\",
|
|
\"k. c #214493\",
|
|
\"l. c #F2DD6C\",
|
|
\"m. c #F8EB7E\",
|
|
\"n. c #FBEE7A\",
|
|
\"o. c #FBE461\",
|
|
\"p. c #FADB48\",
|
|
\"q. c #FBD631\",
|
|
\"r. c #FED10F\",
|
|
\"s. c #FECD07\",
|
|
\"t. c #F1BD00\",
|
|
\"u. c #456AAE\",
|
|
\"v. c #4C7ECA\",
|
|
\"w. c #487AC8\",
|
|
\"x. c #35528F\",
|
|
\"y. c #1B4294\",
|
|
\"z. c #1B4193\",
|
|
\"A. c #F9EA83\",
|
|
\"B. c #FCF08E\",
|
|
\"C. c #F6E16E\",
|
|
\"D. c #F4D559\",
|
|
\"E. c #F5CF45\",
|
|
\"F. c #F6CB2E\",
|
|
\"G. c #F8C611\",
|
|
\"H. c #F6C005\",
|
|
\"I. c #E8B300\",
|
|
\"J. c #4268AE\",
|
|
\"K. c #4375C4\",
|
|
\"L. c #3F71C1\",
|
|
\"M. c #33569B\",
|
|
\"N. c #173F94\",
|
|
\"O. c #183A8B\",
|
|
\"P. c #F3E36E\",
|
|
\"Q. c #FCF7A1\",
|
|
\"R. c #FEF9A1\",
|
|
\"S. c #FEEE7D\",
|
|
\"T. c #FCE360\",
|
|
\"U. c #FAD946\",
|
|
\"V. c #F9D132\",
|
|
\"W. c #F8CD26\",
|
|
\"X. c #F7CA20\",
|
|
\"Y. c #3B589A\",
|
|
\"Z. c #395FA9\",
|
|
\"`. c #3359A5\",
|
|
\" + c #3056A3\",
|
|
\".+ c #2B468D\",
|
|
\"++ c #0A3897\",
|
|
\"@+ c #E6D465\",
|
|
\"#+ c #FDFA90\",
|
|
\"$+ c #FFF885\",
|
|
\"%+ c #FFF074\",
|
|
\"&+ c #FFEA60\",
|
|
\"*+ c #FFE246\",
|
|
\"=+ c #FFDC31\",
|
|
\"-+ c #FED51F\",
|
|
\";+ c #F7CB14\",
|
|
\">+ c #173788\",
|
|
\",+ c #063494\",
|
|
\"'+ c #E8DE7B\",
|
|
\")+ c #FFFA86\",
|
|
\"!+ c #FFF26A\",
|
|
\"~+ c #FFE84F\",
|
|
\"{+ c #FFD415\",
|
|
\"]+ c #FDCC04\",
|
|
\"^+ c #F3C001\",
|
|
\"/+ c #EBB600\",
|
|
\"(+ c #E3AF01\",
|
|
\"_+ c #D7A100\",
|
|
\":+ c #2D3E7F\",
|
|
\"<+ c #033396\",
|
|
\"[+ c #CFB954\",
|
|
\"}+ c #DBC347\",
|
|
\"|+ c #DEBF2C\",
|
|
\"1+ c #DFB718\",
|
|
\"2+ c #DFB206\",
|
|
\"3+ c #D6A505\",
|
|
\"4+ c #C6970A\",
|
|
\"5+ c #B48413\",
|
|
\"6+ c #374682\",
|
|
\"7+ c #023398\",
|
|
\"8+ c #0E3287\",
|
|
\"9+ c #253775\",
|
|
\"0+ c #05318F\",
|
|
\"a+ c #10358B\",
|
|
\"b+ c #183888\",
|
|
\"c+ c #053495\",
|
|
\"d+ c #0E348D\",
|
|
\"e+ c #183585\",
|
|
\" . . . . . . . \",
|
|
\" . . + @ # $ % & * . . . \",
|
|
\" . = - ; > , ' ) ! ~ { ] ^ . \",
|
|
\". / ( _ : ; < [ } | 1 2 3 4 5 . \",
|
|
\". 6 7 8 9 > , ' ) ! ~ 0 ] a b . \",
|
|
\". c d 8 9 > , ' ) ! e 0 ] a f . \",
|
|
\". g h i j k l m | n o p q r s . \",
|
|
\". t u v w x y z 2 A B C D E F . \",
|
|
\". G H I J K L M N O P Q R F F . \",
|
|
\". S T U V W p X Y Z ` ...+.@.. . . . . \",
|
|
\". #.$.%.&.*.=.-.;.>.. . ,.'.. ).!.~.{.].. \",
|
|
\". ^./.(._.:.<.[.}.|.. 1.. . 2.3.4.. . 5.6.. \",
|
|
\". 7.8.9.0.) a.b.c.d.. e.f.g.h.i.. . j.k.. \",
|
|
\". l.m.n.o.p.q.r.s.t.. u.v.w.x.. . y.z.. \",
|
|
\". A.B.C.D.E.F.G.H.I.. J.K.L.M.. . N.O.. \",
|
|
\". P.Q.R.S.T.U.V.W.X.. Y.Z.`. +.+. . ++. \",
|
|
\". @+#+$+%+&+*+=+-+;+. . . . . . . . >+,+. \",
|
|
\" . '+)+!+~+{ {+]+^+/+(+_+. . :+<+. \",
|
|
\" . . [+}+|+1+2+3+4+5+. . 6+7+8+. \",
|
|
\" . . . . . . . . . 9+0+a+. \",
|
|
\" . b+c+d+. \",
|
|
\" . e+. . \",
|
|
\" . \",
|
|
\" \"};
|
|
"
|
|
"XPM format image used as Rollback icon")
|
|
|
|
(defconst sqlplus-commit-xpm "\
|
|
/* XPM */
|
|
static char * commit_xpm[] = {
|
|
\"24 24 276 2\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #FDF57D\",
|
|
\"@ c #FFF676\",
|
|
\"# c #FFF36C\",
|
|
\"$ c #FFF05D\",
|
|
\"% c #FFEB51\",
|
|
\"& c #FFE445\",
|
|
\"* c #FDDC35\",
|
|
\"= c #EFEA85\",
|
|
\"- c #FBF68D\",
|
|
\"; c #FCF482\",
|
|
\"> c #FCF178\",
|
|
\", c #FCEE6E\",
|
|
\"' c #FCEB66\",
|
|
\") c #FCE85B\",
|
|
\"! c #FCE551\",
|
|
\"~ c #FDE147\",
|
|
\"{ c #FDDF3D\",
|
|
\"] c #FEDD2D\",
|
|
\"^ c #FCD621\",
|
|
\"/ c #E5BF16\",
|
|
\"( c #D8D479\",
|
|
\"_ c #FCF587\",
|
|
\": c #FAEF78\",
|
|
\"< c #FAEA6B\",
|
|
\"[ c #FAEA6A\",
|
|
\"} c #FAE968\",
|
|
\"| c #FAE967\",
|
|
\"1 c #FAE865\",
|
|
\"2 c #FAE864\",
|
|
\"3 c #FDDD3C\",
|
|
\"4 c #FED621\",
|
|
\"5 c #FFD51D\",
|
|
\"6 c #FFD51B\",
|
|
\"7 c #FFD519\",
|
|
\"8 c #D8B82B\",
|
|
\"9 c #FCF790\",
|
|
\"0 c #FBF587\",
|
|
\"a c #F8EF7D\",
|
|
\"b c #F8EC75\",
|
|
\"c c #F7E86B\",
|
|
\"d c #F8E868\",
|
|
\"e c #F9E663\",
|
|
\"f c #F9E45A\",
|
|
\"g c #F9E253\",
|
|
\"h c #F9E04C\",
|
|
\"i c #FBDD40\",
|
|
\"j c #FBDB38\",
|
|
\"k c #FAD933\",
|
|
\"l c #FAD529\",
|
|
\"m c #FDD810\",
|
|
\"n c #FFFD9E\",
|
|
\"o c #FFFF9A\",
|
|
\"p c #FFFE96\",
|
|
\"q c #FFFB8C\",
|
|
\"r c #FFF781\",
|
|
\"s c #FFF375\",
|
|
\"t c #FFEF69\",
|
|
\"u c #FFEA5B\",
|
|
\"v c #FFE750\",
|
|
\"w c #FFE345\",
|
|
\"x c #FFDF38\",
|
|
\"y c #FFDB2B\",
|
|
\"z c #FFD81F\",
|
|
\"A c #FFD313\",
|
|
\"B c #FBD007\",
|
|
\"C c #FBF090\",
|
|
\"D c #FFFDAE\",
|
|
\"E c #FFFEA2\",
|
|
\"F c #FFFA8C\",
|
|
\"G c #FFF780\",
|
|
\"H c #F6CA11\",
|
|
\"I c #E1AF03\",
|
|
\"J c #F4E36D\",
|
|
\"K c #FCF7A4\",
|
|
\"L c #FFFEBB\",
|
|
\"M c #FEFAA6\",
|
|
\"N c #FFF990\",
|
|
\"O c #FFF57E\",
|
|
\"P c #FFEE6F\",
|
|
\"Q c #FFEB61\",
|
|
\"R c #FFE856\",
|
|
\"S c #FFE34A\",
|
|
\"T c #FBDD44\",
|
|
\"U c #F7D535\",
|
|
\"V c #EBBF13\",
|
|
\"W c #D5A406\",
|
|
\"X c #C99500\",
|
|
\"Y c #F0DC5F\",
|
|
\"Z c #F3E772\",
|
|
\"` c #F7EC76\",
|
|
\" . c #F6E56D\",
|
|
\".. c #F6E369\",
|
|
\"+. c #F6E264\",
|
|
\"@. c #F5DF5C\",
|
|
\"#. c #F3DB53\",
|
|
\"$. c #F3D849\",
|
|
\"%. c #EFD245\",
|
|
\"&. c #ECCE3F\",
|
|
\"*. c #E3B91F\",
|
|
\"=. c #D3A40B\",
|
|
\"-. c #C99600\",
|
|
\";. c #C69200\",
|
|
\">. c #EED95E\",
|
|
\",. c #EDDA60\",
|
|
\"'. c #F1DF64\",
|
|
\"). c #F2DF5E\",
|
|
\"!. c #F2DD57\",
|
|
\"~. c #F2D94E\",
|
|
\"{. c #F2D644\",
|
|
\"]. c #EFD038\",
|
|
\"^. c #ECCB34\",
|
|
\"/. c #E6C430\",
|
|
\"(. c #DFB71F\",
|
|
\"_. c #D9AD17\",
|
|
\":. c #CC9907\",
|
|
\"<. c #C69000\",
|
|
\"[. c #D39E00\",
|
|
\"}. c #BB1503\",
|
|
\"|. c #F9EA7D\",
|
|
\"1. c #F6E57A\",
|
|
\"2. c #F5E370\",
|
|
\"3. c #F5DE62\",
|
|
\"4. c #F9DF52\",
|
|
\"5. c #FBDB3E\",
|
|
\"6. c #FCD526\",
|
|
\"7. c #FCCE0F\",
|
|
\"8. c #F7C50A\",
|
|
\"9. c #EEBA08\",
|
|
\"0. c #E2AB03\",
|
|
\"a. c #D7A000\",
|
|
\"b. c #D59D00\",
|
|
\"c. c #DFA901\",
|
|
\"d. c #E7B402\",
|
|
\"e. c #C91800\",
|
|
\"f. c #F6E676\",
|
|
\"g. c #FCF4A1\",
|
|
\"h. c #FDF096\",
|
|
\"i. c #FAE167\",
|
|
\"j. c #F7D64F\",
|
|
\"k. c #F7CF38\",
|
|
\"l. c #F7CB26\",
|
|
\"m. c #F6BF0C\",
|
|
\"n. c #F1B905\",
|
|
\"o. c #ECB309\",
|
|
\"p. c #EBB60A\",
|
|
\"q. c #F0BF0B\",
|
|
\"r. c #F3C206\",
|
|
\"s. c #E5B201\",
|
|
\"t. c #CF9C01\",
|
|
\"u. c #C21602\",
|
|
\"v. c #C21703\",
|
|
\"w. c #F2E067\",
|
|
\"x. c #FBF78F\",
|
|
\"y. c #FEF28A\",
|
|
\"z. c #FEED74\",
|
|
\"A. c #FFE85F\",
|
|
\"B. c #FFE24D\",
|
|
\"C. c #FFDE3A\",
|
|
\"D. c #FED92F\",
|
|
\"E. c #FCD325\",
|
|
\"F. c #F8CD1A\",
|
|
\"G. c #EDBD0A\",
|
|
\"H. c #D9A701\",
|
|
\"I. c #C79200\",
|
|
\"J. c #D11D00\",
|
|
\"K. c #EFDA64\",
|
|
\"L. c #F7EF7F\",
|
|
\"M. c #FCF47F\",
|
|
\"N. c #FDEE6C\",
|
|
\"O. c #FDE85B\",
|
|
\"P. c #FDE249\",
|
|
\"Q. c #FDDC36\",
|
|
\"R. c #FCD423\",
|
|
\"S. c #F9CC14\",
|
|
\"T. c #F0C10E\",
|
|
\"U. c #E6B507\",
|
|
\"V. c #DCA900\",
|
|
\"W. c #D29F00\",
|
|
\"X. c #C69400\",
|
|
\"Y. c #C99200\",
|
|
\"Z. c #CC1B02\",
|
|
\"`. c #C61A04\",
|
|
\" + c #E1CF5F\",
|
|
\".+ c #EAD862\",
|
|
\"++ c #ECDB63\",
|
|
\"@+ c #EFDC5E\",
|
|
\"#+ c #EFD955\",
|
|
\"$+ c #EFD74D\",
|
|
\"%+ c #EFD444\",
|
|
\"&+ c #F0D23E\",
|
|
\"*+ c #EECE37\",
|
|
\"=+ c #E8C731\",
|
|
\"-+ c #E0B922\",
|
|
\";+ c #D09E03\",
|
|
\">+ c #CB9700\",
|
|
\",+ c #C39100\",
|
|
\"'+ c #C99400\",
|
|
\")+ c #E12400\",
|
|
\"!+ c #F2E47C\",
|
|
\"~+ c #F8ED8C\",
|
|
\"{+ c #F4E171\",
|
|
\"]+ c #F0D65B\",
|
|
\"^+ c #F0D24F\",
|
|
\"/+ c #F1CF43\",
|
|
\"(+ c #F2CD34\",
|
|
\"_+ c #F2C824\",
|
|
\":+ c #EEC527\",
|
|
\"<+ c #E7BD23\",
|
|
\"[+ c #DFAC12\",
|
|
\"}+ c #DAA203\",
|
|
\"|+ c #E5B202\",
|
|
\"1+ c #EDBA01\",
|
|
\"2+ c #D69F00\",
|
|
\"3+ c #D21E01\",
|
|
\"4+ c #D01C00\",
|
|
\"5+ c #F2E16A\",
|
|
\"6+ c #FBF59D\",
|
|
\"7+ c #FEFBAA\",
|
|
\"8+ c #FEF084\",
|
|
\"9+ c #FCE567\",
|
|
\"0+ c #FBDD50\",
|
|
\"a+ c #F8D23B\",
|
|
\"b+ c #F8CD28\",
|
|
\"c+ c #EEB51C\",
|
|
\"d+ c #DA8A13\",
|
|
\"e+ c #E29A16\",
|
|
\"f+ c #EDB111\",
|
|
\"g+ c #E5AE08\",
|
|
\"h+ c #D19C01\",
|
|
\"i+ c #C79400\",
|
|
\"j+ c #BF1603\",
|
|
\"k+ c #DD2300\",
|
|
\"l+ c #E6D261\",
|
|
\"m+ c #FCF88C\",
|
|
\"n+ c #FFF27A\",
|
|
\"o+ c #FFEC6A\",
|
|
\"p+ c #FFE655\",
|
|
\"q+ c #FFE041\",
|
|
\"r+ c #FFDA2B\",
|
|
\"s+ c #E49D14\",
|
|
\"t+ c #BA4F02\",
|
|
\"u+ c #BB6A00\",
|
|
\"v+ c #B37102\",
|
|
\"w+ c #DD2200\",
|
|
\"x+ c #CA1B02\",
|
|
\"y+ c #E6DB78\",
|
|
\"z+ c #FEFB8B\",
|
|
\"A+ c #FFF470\",
|
|
\"B+ c #FFEA56\",
|
|
\"C+ c #FFE13E\",
|
|
\"D+ c #FFDA24\",
|
|
\"E+ c #FECF0A\",
|
|
\"F+ c #F5BE01\",
|
|
\"G+ c #D37800\",
|
|
\"H+ c #D72000\",
|
|
\"I+ c #C61802\",
|
|
\"J+ c #EBD55C\",
|
|
\"K+ c #FCE353\",
|
|
\"L+ c #FFE33E\",
|
|
\"M+ c #FFDB26\",
|
|
\"N+ c #FFD20B\",
|
|
\"O+ c #FCCB01\",
|
|
\"P+ c #F0B900\",
|
|
\"Q+ c #D47D00\",
|
|
\"R+ c #E42500\",
|
|
\"S+ c #EB2900\",
|
|
\"T+ c #DF2301\",
|
|
\"U+ c #E82700\",
|
|
\"V+ c #D31F04\",
|
|
\"W+ c #C71F01\",
|
|
\"X+ c #EA2800\",
|
|
\"Y+ c #E92800\",
|
|
\"Z+ c #DD2301\",
|
|
\"`+ c #E22501\",
|
|
\" . . . . . . . \",
|
|
\" . . . + @ # $ % & * . . . \",
|
|
\" . = - ; > , ' ) ! ~ { ] ^ / . \",
|
|
\". ( _ : < [ } | 1 2 3 4 5 6 7 8 . \",
|
|
\". 9 0 a b c d e f g h i j k l m . \",
|
|
\". n o p q r s t u v w x y z A B . \",
|
|
\". C D E F G s t u v w x y z H I . \",
|
|
\". J K L M N O P Q R S T U V W X . \",
|
|
\". Y Z ` ...+.@.#.$.%.&.*.=.-.;.. . . \",
|
|
\". >.,.'.).!.~.{.].^./.(._.:.<.[.. . }.. \",
|
|
\". |.1.2.3.4.5.6.7.8.9.0.a.b.c.d.. . e.. \",
|
|
\". f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.. . u.v.. \",
|
|
\". w.x.n y.z.A.B.C.D.E.F.G.H.-.I.. . J.. \",
|
|
\". K.L.M.N.O.P.Q.R.S.T.U.V.W.X.Y.. . Z.`.. \",
|
|
\". +.+++@+#+$+%+&+*+=+-+;+>+,+'+. . )+. \",
|
|
\". !+~+{+]+^+/+(+_+:+<+[+}+|+1+2+. . 3+4+. \",
|
|
\". 5+6+7+8+9+0+a+b+c+d+e+f+g+h+i+. j+k+. \",
|
|
\". l+m+q n+o+p+q+r+s+. . . t+u+v+. w+x+. \",
|
|
\" . y+z+A+B+C+D+E+F+G+. H+. . . I+)+. \",
|
|
\" . . J+K+L+M+N+O+P+Q+. R+S+T+U+V+. \",
|
|
\" . . . . . . . . . . W+X+Y+. \",
|
|
\" . Z+`+. \",
|
|
\" . . \",
|
|
\" . \"};
|
|
"
|
|
"XPM format image used as Commit icon")
|
|
|
|
(defconst plsql-prev-mark-xpm "\
|
|
/* XPM */
|
|
static char * go_previous_xpm[] = {
|
|
\"24 24 59 1\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #355D96\",
|
|
\"@ c #3C639B\",
|
|
\"# c #6E92BF\",
|
|
\"$ c #41679D\",
|
|
\"% c #6990BE\",
|
|
\"& c #6D94C2\",
|
|
\"* c #456DA2\",
|
|
\"= c #628BBC\",
|
|
\"- c #4D7BB4\",
|
|
\"; c #6991C0\",
|
|
\"> c #4971A6\",
|
|
\", c #5D87BA\",
|
|
\"' c #4B7BB3\",
|
|
\") c #4979B3\",
|
|
\"! c #5884B9\",
|
|
\"~ c #638CBC\",
|
|
\"{ c #638BBC\",
|
|
\"] c #6089BA\",
|
|
\"^ c #4B73A9\",
|
|
\"/ c #5883B8\",
|
|
\"( c #4A7AB3\",
|
|
\"_ c #618ABB\",
|
|
\": c #4C74AB\",
|
|
\"< c #547FB5\",
|
|
\"[ c #4972A9\",
|
|
\"} c #4D79B1\",
|
|
\"| c #4171AD\",
|
|
\"1 c #4071AD\",
|
|
\"2 c #4070AD\",
|
|
\"3 c #4171AC\",
|
|
\"4 c #4071AC\",
|
|
\"5 c #4070AC\",
|
|
\"6 c #3F70AC\",
|
|
\"7 c #3F70AB\",
|
|
\"8 c #406FAC\",
|
|
\"9 c #5781B5\",
|
|
\"0 c #4A74AC\",
|
|
\"a c #3E6CA8\",
|
|
\"b c #3465A4\",
|
|
\"c c #4E78AF\",
|
|
\"d c #446FA8\",
|
|
\"e c #4A75AD\",
|
|
\"f c #3F6CA6\",
|
|
\"g c #3C6BA7\",
|
|
\"h c #3B6BA7\",
|
|
\"i c #4471AB\",
|
|
\"j c #4572AB\",
|
|
\"k c #4672AC\",
|
|
\"l c #4571AB\",
|
|
\"m c #3A68A3\",
|
|
\"n c #3B6AA7\",
|
|
\"o c #406EA9\",
|
|
\"p c #3564A0\",
|
|
\"q c #3868A6\",
|
|
\"r c #305E9D\",
|
|
\"s c #3767A5\",
|
|
\"t c #2E5D9B\",
|
|
\" \",
|
|
\" \",
|
|
\" \",
|
|
\" .. \",
|
|
\" .+. \",
|
|
\" .@#. \",
|
|
\" .$%&. \",
|
|
\" .*=-;......... \",
|
|
\" .>,')!~{{{{{~]. \",
|
|
\" .^/()))(((((('_. \",
|
|
\" .:<)))))))))))),. \",
|
|
\" .[}|1123455567589. \",
|
|
\" .0abbbbbbbbbbbbc. \",
|
|
\" .dabbbbbbbbbbbe. \",
|
|
\" .fgbbhijjjjjkl. \",
|
|
\" .mnbo......... \",
|
|
\" .pqh. \",
|
|
\" .rs. \",
|
|
\" .t. \",
|
|
\" .. \",
|
|
\" . \",
|
|
\" \",
|
|
\" \",
|
|
\" \"};
|
|
"
|
|
"XPM format image used as Previous Mark icon")
|
|
|
|
(defconst plsql-next-mark-xpm "\
|
|
/* XPM */
|
|
static char * go_next_xpm[] = {
|
|
\"24 24 63 1\",
|
|
\" c None\",
|
|
\". c #000000\",
|
|
\"+ c #365F97\",
|
|
\"@ c #6B8FBE\",
|
|
\"# c #41689E\",
|
|
\"$ c #6990BF\",
|
|
\"% c #466EA4\",
|
|
\"& c #678EBD\",
|
|
\"* c #4E7DB5\",
|
|
\"= c #638CBC\",
|
|
\"- c #4B72A7\",
|
|
\"; c #5B83B5\",
|
|
\"> c #628BBB\",
|
|
\", c #5A86BA\",
|
|
\"' c #4979B3\",
|
|
\") c #4B7AB3\",
|
|
\"! c #5E87B9\",
|
|
\"~ c #4E76AA\",
|
|
\"{ c #5B84B8\",
|
|
\"] c #4E7CB5\",
|
|
\"^ c #4A7AB3\",
|
|
\"/ c #5883B7\",
|
|
\"( c #5178AD\",
|
|
\"_ c #5982B6\",
|
|
\": c #4C7BB4\",
|
|
\"< c #537FB5\",
|
|
\"[ c #5079AE\",
|
|
\"} c #507BB0\",
|
|
\"| c #4272AD\",
|
|
\"1 c #4070AC\",
|
|
\"2 c #3F70AB\",
|
|
\"3 c #3F70AC\",
|
|
\"4 c #4071AC\",
|
|
\"5 c #4171AC\",
|
|
\"6 c #4070AD\",
|
|
\"7 c #4071AD\",
|
|
\"8 c #4171AD\",
|
|
\"9 c #4D79B1\",
|
|
\"0 c #4E76AD\",
|
|
\"a c #4872AA\",
|
|
\"b c #3767A5\",
|
|
\"c c #3465A4\",
|
|
\"d c #3D6CA8\",
|
|
\"e c #4C76AD\",
|
|
\"f c #2B548E\",
|
|
\"g c #446FA8\",
|
|
\"h c #3C6BA7\",
|
|
\"i c #4772AA\",
|
|
\"j c #29528E\",
|
|
\"k c #3F6CA6\",
|
|
\"l c #4471AB\",
|
|
\"m c #4371AB\",
|
|
\"n c #3B6BA7\",
|
|
\"o c #416EA8\",
|
|
\"p c #3F6CA7\",
|
|
\"q c #3A69A6\",
|
|
\"r c #3C6AA5\",
|
|
\"s c #3B6AA5\",
|
|
\"t c #3868A6\",
|
|
\"u c #3765A2\",
|
|
\"v c #3666A3\",
|
|
\"w c #32619F\",
|
|
\"x c #2F5D9B\",
|
|
\" \",
|
|
\" \",
|
|
\" \",
|
|
\" .. \",
|
|
\" .+. \",
|
|
\" .@#. \",
|
|
\" .$$%. \",
|
|
\" .........&*=-. \",
|
|
\" .;>>>>>>=,')!~. \",
|
|
\" .{]^^^^^^''''/(. \",
|
|
\" ._:'''''''''''<[. \",
|
|
\" .}|12311145677890. \",
|
|
\" .abcccccccccccde. \",
|
|
\" .gbcccccccccchi. \",
|
|
\" .klmlllllhccno. \",
|
|
\" .........pcqr. \",
|
|
\" .stu. \",
|
|
\" .vw. \",
|
|
\" .x. \",
|
|
\" .. \",
|
|
\" . \",
|
|
\" \",
|
|
\" \",
|
|
\" \"};
|
|
"
|
|
"XPM format image used as Next Mark icon")
|
|
|
|
(defconst sqlplus-kill-image
|
|
(create-image sqlplus-kill-xpm 'xpm t))
|
|
|
|
(defconst sqlplus-cancel-image
|
|
(create-image sqlplus-cancel-xpm 'xpm t))
|
|
|
|
(defconst sqlplus-commit-image
|
|
(create-image sqlplus-commit-xpm 'xpm t))
|
|
|
|
(defconst sqlplus-rollback-image
|
|
(create-image sqlplus-rollback-xpm 'xpm t))
|
|
|
|
(defconst plsql-prev-mark-image
|
|
(create-image plsql-prev-mark-xpm 'xpm t))
|
|
|
|
(defconst plsql-next-mark-image
|
|
(create-image plsql-next-mark-xpm 'xpm t))
|
|
|
|
(defvar sqlplus-mode-syntax-table nil
|
|
"Syntax table used while in sqlplus-mode.")
|
|
|
|
(defvar sqlplus-suppress-show-output-buffer nil)
|
|
|
|
;; Local in input buffers
|
|
(defvar sqlplus-font-lock-keywords-1 nil)
|
|
(make-variable-buffer-local 'sqlplus-font-lock-keywords-1)
|
|
(defvar sqlplus-font-lock-keywords-2 nil)
|
|
(make-variable-buffer-local 'sqlplus-font-lock-keywords-2)
|
|
(defvar sqlplus-font-lock-keywords-3 nil)
|
|
(make-variable-buffer-local 'sqlplus-font-lock-keywords-3)
|
|
|
|
(defvar sqlplus-font-lock-defaults '((sqlplus-font-lock-keywords-1 sqlplus-font-lock-keywords-2 sqlplus-font-lock-keywords-3) nil t nil nil))
|
|
|
|
(defvar sqlplus-oracle-extra-builtin-functions-re
|
|
(concat "\\b"
|
|
(regexp-opt '("acos" "asciistr" "asin" "atan" "atan2" "bfilename" "bin_to_num" "bitand" "cardinality" "cast" "coalesce" "collect"
|
|
"compose" "corr" "corr_s" "corr_k" "covar_pop" "covar_samp" "cume_dist" "current_date" "current_timestamp" "cv"
|
|
"dbtimezone" "decompose" "dense_rank" "depth" "deref" "empty_blob, empty_clob" "existsnode" "extract"
|
|
"extractvalue" "first" "first_value" "from_tz" "group_id" "grouping" "grouping_id" "iteration_number"
|
|
"lag" "last" "last_value" "lead" "lnnvl" "localtimestamp" "make_ref" "median" "nanvl" "nchr" "nls_charset_decl_len"
|
|
"nls_charset_id" "nls_charset_name" "ntile" "nullif" "numtodsinterval" "numtoyminterval" "nvl2" "ora_hash" "path"
|
|
"percent_rank" "percentile_cont" "percentile_disc" "powermultiset" "powermultiset_by_cardinality" "presentnnv"
|
|
"presentv" "previous" "rank" "ratio_to_report" "rawtonhex" "ref" "reftohex" "regexp_instr" "regexp_replace"
|
|
"regexp_substr" "regr_slope" "regr_intercept" "regr_count" "regr_r2" "regr_avgx" "regr_avgy" "regr_sxx" "regr_syy"
|
|
"regr_sxy" "remainder" "row_number" "rowidtonchar" "scn_to_timestamp" "sessiontimezone" "stats_binomial_test"
|
|
"stats_crosstab" "stats_f_test" "stats_ks_test" "stats_mode" "stats_mw_test" "stats_one_way_anova" "stats_t_test_one"
|
|
"stats_t_test_paired" "stats_t_test_indep" "stats_t_test_indepu" "stats_wsr_test" "stddev_pop" "stddev_samp"
|
|
"sys_connect_by_path" "sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid" "sys_xmlagg" "sys_xmlgen"
|
|
"systimestamp" "timestamp_to_scn" "to_binary_double" "to_binary_float" "to_clob" "to_dsinterval" "to_lob" "to_nchar"
|
|
"to_nclob" "to_timestamp" "to_timestamp_tz" "to_yminterval" "treat" "tz_offset" "unistr" "updatexml" "value" "var_pop"
|
|
"var_samp" "width_bucket" "xmlagg" "xmlcolattval" "xmlconcat" "xmlelement" "xmlforest" "xmlsequence" "xmltransform") t)
|
|
"\\b"))
|
|
(defvar sqlplus-oracle-extra-warning-words-re
|
|
(concat "\\b"
|
|
(regexp-opt '("access_into_null" "case_not_found" "collection_is_null" "rowtype_mismatch"
|
|
"self_is_null" "subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid") t)
|
|
"\\b"))
|
|
(defvar sqlplus-oracle-extra-keywords-re
|
|
(concat "\\b\\("
|
|
"\\(at\\s-+local\\|at\\s-+time\\s-+zone\\|to\\s-+second\\|to\\s-+month\\|is\\s-+present\\|a\\s-+set\\)\\|"
|
|
(regexp-opt '("case" "nan" "infinite" "equals_path" "empty" "likec" "like2" "like4" "member"
|
|
"regexp_like" "submultiset" "under_path" "mlslabel") t)
|
|
"\\)\\b"))
|
|
(defvar sqlplus-oracle-extra-pseudocolumns-re
|
|
(concat "\\b"
|
|
(regexp-opt '("connect_by_iscycle" "connect_by_isleaf" "versions_starttime" "versions_startscn"
|
|
"versions_endtime" "versions_endscn" "versions_xid" "versions_operation" "object_id" "object_value" "ora_rowscn"
|
|
"xmldata") t)
|
|
"\\b"))
|
|
(defvar sqlplus-oracle-plsql-extra-reserved-words-re
|
|
(concat "\\b"
|
|
(regexp-opt '("array" "at" "authid" "bulk" "char_base" "day" "do" "extends" "forall" "heap" "hour"
|
|
"interface" "isolation" "java" "limited" "minute" "mlslabel" "month" "natural" "naturaln" "nocopy" "number_base"
|
|
"ocirowid" "opaque" "operator" "organization" "pls_integer" "positive" "positiven" "range" "record" "release" "reverse"
|
|
"rowtype" "second" "separate" "space" "sql" "timezone_region" "timezone_abbr" "timezone_minute" "timezone_hour" "year"
|
|
"zone") t)
|
|
"\\b"))
|
|
(defvar sqlplus-oracle-extra-types-re
|
|
(concat "\\b"
|
|
(regexp-opt '("nvarchar2" "binary_float" "binary_double" "timestamp" "interval" "interval_day" "urowid" "nchar" "clob" "nclob" "bfile") t)
|
|
"\\b"))
|
|
|
|
(defvar sqlplus-commands-regexp-1 nil)
|
|
(defvar sqlplus-commands-regexp-23 nil)
|
|
(defvar sqlplus-system-variables-regexp-1 nil)
|
|
(defvar sqlplus-system-variables-regexp-23 nil)
|
|
(defvar sqlplus-v22-commands-font-lock-keywords-1 nil)
|
|
(defvar sqlplus-v22-commands-font-lock-keywords-23 nil)
|
|
(defvar font-lock-sqlplus-face nil)
|
|
|
|
(defvar sqlplus-output-buffer-keymap nil
|
|
"Local in output buffer.")
|
|
(make-variable-buffer-local 'sqlplus-output-buffer-keymap)
|
|
|
|
(defvar sqlplus-kill-function-inhibitor nil)
|
|
|
|
(defvar sqlplus-slip-separator-width 2
|
|
"Only for classic table style.")
|
|
|
|
(defvar sqlplus-user-string-history nil)
|
|
|
|
(defvar sqlplus-object-types '( "CONSUMER GROUP" "SEQUENCE" "SCHEDULE" "PROCEDURE" "OPERATOR" "WINDOW"
|
|
"PACKAGE" "LIBRARY" "PROGRAM" "PACKAGE BODY" "JAVA RESOURCE" "XML SCHEMA"
|
|
"JOB CLASS" "TRIGGER" "TABLE" "SYNONYM" "VIEW" "FUNCTION" "WINDOW GROUP"
|
|
"JAVA CLASS" "INDEXTYPE" "INDEX" "TYPE" "EVALUATION CONTEXT" ))
|
|
|
|
(defvar sqlplus-end-of-source-sentinel "%%@@end-of-source-sentinel@@%%")
|
|
|
|
(defconst sqlplus-system-variables
|
|
'("appi[nfo]" "array[size]" "auto[commit]" "autop[rint]" "autorecovery" "autot[race]" "blo[ckterminator]" "cmds[ep]"
|
|
"colsep" "com[patibility]" "con[cat]" "copyc[ommit]" "copytypecheck" "def[ine]" "describe" "echo" "editf[ile]"
|
|
"emb[edded]" "esc[ape]" "feed[back]" "flagger" "flu[sh]" "hea[ding]" "heads[ep]" "instance" "lin[esize]"
|
|
"lobof[fset]" "logsource" "long" "longc[hunksize]" "mark[up]" "newp[age]" "null" "numf[ormat]" "num[width]"
|
|
"pages[ize]" "pau[se]" "recsep" "recsepchar" "serverout[put]" "shift[inout]" "show[mode]" "sqlbl[anklines]"
|
|
"sqlc[ase]" "sqlco[ntinue]" "sqln[umber]" "sqlpluscompat[ibility]" "sqlpre[fix]" "sqlp[rompt]" "sqlt[erminator]"
|
|
"suf[fix]" "tab" "term[out]" "ti[me]" "timi[ng]" "trim[out]" "trims[pool]" "und[erline]" "ver[ify]" "wra[p]"))
|
|
|
|
(defconst sqlplus-commands
|
|
'(("@[@]")
|
|
(("/" "r[un]"))
|
|
("acc[ept]"
|
|
(font-lock-type-face "num[ber]" "char" "date" "binary_float" "binary_double")
|
|
(font-lock-keyword-face "for[mat]" "def[ault]" "[no]prompt" "hide"))
|
|
("a[ppend]")
|
|
("archive log"
|
|
(font-lock-keyword-face "list" "stop" "start" "next" "all" "to"))
|
|
("attribute"
|
|
(font-lock-keyword-face "ali[as]" "cle[ar]" "for[mat]" "like" "on" "off"))
|
|
("bre[ak]"
|
|
(font-lock-keyword-face "on" "row" "report" "ski[p]" "page" "nodup[licates]" "dup[licates]"))
|
|
("bti[tle]"
|
|
(font-lock-keyword-face "on" "off")
|
|
(font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab"))
|
|
("c[hange]")
|
|
("cl[ear]"
|
|
(font-lock-keyword-face "bre[aks]" "buff[er]" "col[umns]" "comp[utes]" "scr[een]" "sql" "timi[ng]"))
|
|
("col[umn]"
|
|
(font-lock-keyword-face "ali[as]" "cle[ar]" "entmap" "on" "off" "fold_a[fter]" "fold_b[efore]" "for[mat]" "hea[ding]"
|
|
"jus[tify]" "l[eft]" "c[enter]" "r[ight]" "like" "newl[ine]" "new_v[alue]" "nopri[nt]" "pri[nt]"
|
|
"nul[l]" "old_v[alue]" "wra[pped]" "wor[d_wrapped]" "tru[ncated]"))
|
|
("comp[ute]"
|
|
(font-lock-keyword-face "lab[el]" "of" "on" "report" "row")
|
|
(font-lock-builtin-face "avg" "cou[nt]" "min[imum]" "max[imum]" "num[ber]" "sum" "std" "var[iance]"))
|
|
("conn[ect]"
|
|
(font-lock-keyword-face "as" "sysoper" "sysdba"))
|
|
("copy")
|
|
("def[ine]")
|
|
("del"
|
|
(font-lock-keyword-face "last"))
|
|
("desc[ribe]")
|
|
("disc[onnect]")
|
|
("ed[it]")
|
|
("exec[ute]")
|
|
(("exit" "quit")
|
|
(font-lock-keyword-face "success" "failure" "warning" "commit" "rollback"))
|
|
("get"
|
|
(font-lock-keyword-face "file" "lis[t]" "nol[ist]"))
|
|
("help")
|
|
(("ho[st]" "!" "$"))
|
|
("i[nput]")
|
|
("l[ist]"
|
|
(font-lock-keyword-face "last"))
|
|
("passw[ord]")
|
|
("pau[se]")
|
|
("pri[nt]")
|
|
("pro[mpt]")
|
|
("recover"
|
|
(font-lock-keyword-face "begin" "end" "backup" "automatic" "from" "logfile" "test" "allow" "corruption" "continue" "default" "cancel"
|
|
"standby" "database" "until" "time" "change" "using" "controlfile" "tablespace" "datafile"
|
|
"consistent" "with" "[no]parallel" "managed" "disconnect" "session" "[no]timeout" "[no]delay" "next" "no" "expire"
|
|
"current" "through" "thread" "sequence" "all" "archivelog" "last" "switchover" "immediate" "[no]wait"
|
|
"finish" "skip"))
|
|
("rem[ark]")
|
|
("repf[ooter]"
|
|
(font-lock-keyword-face "page" "on" "off")
|
|
(font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab"))
|
|
("reph[eader]"
|
|
(font-lock-keyword-face "page" "on" "off")
|
|
(font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab"))
|
|
("sav[e]"
|
|
(font-lock-keyword-face "file" "cre[ate]" "rep[lace]" "app[end]"))
|
|
("set"
|
|
(font-lock-builtin-face sqlplus-system-variables)
|
|
(font-lock-keyword-face "on" "off" "immediate" "trace[only]" "explain" "statistics" "native" "v7" "v8" "all" "linenum" "indent"
|
|
"entry" "intermediate" "full" "local" "head" "html" "body" "table" "entmap" "spool" "[pre]format"
|
|
"none" "[word_]wrapped" "each" "truncated" "[in]visible" "mixed" "lower" "upper"))
|
|
("sho[w]"
|
|
(font-lock-keyword-face "all" "bti[tle]" "err[ors]" "function" "procedure" "package[ body]" "trigger" "view" "type[ body]"
|
|
"dimension" "java class" "lno" "parameters" "pno" "recyc[lebin]" "rel[ease]" "repf[ooter]" "reph[eader]"
|
|
"sga" "spoo[l]" "sqlcode" "tti[tle]" "user")
|
|
(font-lock-builtin-face sqlplus-system-variables))
|
|
("shutdown"
|
|
(font-lock-keyword-face "abort" "immediate" "normal" "transactional" "local"))
|
|
("spo[ol]"
|
|
("cre" "create" "rep" "replace" "app" "append" "off" "out"))
|
|
("sta[rt]")
|
|
("startup"
|
|
(font-lock-keyword-face "force" "restrict" "pfile" "quiet" "mount" "open" "nomount" "read" "only" "write" "recover"))
|
|
("store"
|
|
(font-lock-keyword-face "set" "cre[ate]" "rep[lace]" "app[end]"))
|
|
("timi[ng]"
|
|
(font-lock-keyword-face "start" "show" "stop"))
|
|
("tti[tle]"
|
|
(font-lock-keyword-face "tti[tle]" "on" "off")
|
|
(font-lock-builtin-face "bold" "ce[nter]" "col" "format" "le[ft]" "r[ight]" "s[kip]" "tab"))
|
|
("undef[ine]")
|
|
("var[iable]"
|
|
(font-lock-type-face "number" "[n]char" "byte" "[n]varchar2" "[n]clob" "refcursor" "binary_float" "binary_double"))
|
|
("whenever oserror"
|
|
(font-lock-keyword-face "exit" "success" "failure" "commit" "rollback" "continue" "commit" "rollback" "none"))
|
|
("whenever sqlerror"
|
|
(font-lock-keyword-face "exit" "success" "failure" "warning" "commit" "rollback" "continue" "none"))))
|
|
|
|
(defvar plsql-mode-map nil)
|
|
|
|
(defstruct sqlplus-global-struct
|
|
font-lock-regexps
|
|
objects-alist
|
|
side-view-buffer
|
|
root-dir
|
|
)
|
|
|
|
(defvar sqlplus-global-structures (make-hash-table :test 'equal)
|
|
"Connect string -> sqlplus-global-struct")
|
|
|
|
(defun sqlplus-get-objects-alist (&optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(sqlplus-global-struct-objects-alist struct))))
|
|
|
|
(defun sqlplus-set-objects-alist (objects-alist &optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(setf (sqlplus-global-struct-objects-alist struct) objects-alist))))
|
|
|
|
(defun sqlplus-get-font-lock-regexps (&optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(sqlplus-global-struct-font-lock-regexps struct))))
|
|
|
|
(defun sqlplus-set-font-lock-regexps (font-lock-regexps &optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(setf (sqlplus-global-struct-font-lock-regexps struct) font-lock-regexps))))
|
|
|
|
(defun sqlplus-get-side-view-buffer (&optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(sqlplus-global-struct-side-view-buffer struct))))
|
|
|
|
(defun sqlplus-get-root-dir (&optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(sqlplus-global-struct-root-dir struct))))
|
|
|
|
(defun sqlplus-set-root-dir (root-dir &optional connect-string)
|
|
(let ((struct (gethash (car (refine-connect-string (or connect-string sqlplus-connect-string sqlplus-process-p)))
|
|
sqlplus-global-structures)))
|
|
(when struct
|
|
(setf (sqlplus-global-struct-root-dir struct) root-dir))))
|
|
|
|
;;; ---
|
|
|
|
(defun sqlplus-initial-strings ()
|
|
(append sqlplus-initial-strings
|
|
(list
|
|
(concat "btitle left '" sqlplus-page-separator "'")
|
|
(concat "repfooter left '" sqlplus-repfooter "'")
|
|
(concat "set pagesize " (number-to-string sqlplus-pagesize)))))
|
|
|
|
(defun sqlplus-connect-string-lessp (cs1 cs2)
|
|
"Compare two connect strings"
|
|
(let ((cs1-pair (split-string cs1 "@"))
|
|
(cs2-pair (split-string cs2 "@")))
|
|
(or (string< (cadr cs1-pair) (cadr cs2-pair))
|
|
(and (string= (cadr cs1-pair) (cadr cs2-pair))
|
|
(string< (car cs1-pair) (car cs2-pair))))))
|
|
|
|
(defun sqlplus-divide-connect-strings ()
|
|
"Returns (active-connect-string-list . inactive-connect-string-list)"
|
|
(let* ((active-connect-strings
|
|
(sort (delq nil (mapcar (lambda (buffer)
|
|
(with-current-buffer buffer
|
|
(when (and (eq major-mode 'sqlplus-mode)
|
|
sqlplus-connect-string)
|
|
(let ((cs (car (refine-connect-string sqlplus-connect-string))))
|
|
(when (and (get-buffer (sqlplus-get-process-buffer-name cs))
|
|
(get-process (sqlplus-get-process-name cs)))
|
|
(downcase cs))))))
|
|
(buffer-list)))
|
|
'sqlplus-connect-string-lessp))
|
|
(inactive-connect-strings
|
|
(sort (delq nil (mapcar (lambda (pair)
|
|
(unless (member (downcase (car pair)) active-connect-strings) (downcase (car pair))) )
|
|
sqlplus-connect-strings-alist))
|
|
'sqlplus-connect-string-lessp)))
|
|
(setq active-connect-strings (remove-duplicates active-connect-strings :test 'equal))
|
|
(setq inactive-connect-strings (remove-duplicates inactive-connect-strings :test 'equal))
|
|
(cons active-connect-strings inactive-connect-strings)))
|
|
|
|
(defun sqlplus-connections-menu (menu)
|
|
(condition-case err
|
|
(let* ((connect-strings-pair (sqlplus-divide-connect-strings))
|
|
(active-connect-strings (car connect-strings-pair))
|
|
(inactive-connect-strings (cdr connect-strings-pair)))
|
|
(append
|
|
(list ["New connection..." sqlplus t])
|
|
(list ["Tnsnames.ora" sqlplus-find-tnsnames t])
|
|
(list ["Command Line" sqlplus-command-line t])
|
|
(when (eq major-mode 'sqlplus-mode)
|
|
(list
|
|
"----"
|
|
["Evaluate Statement" sqlplus-send-current sqlplus-connect-string]
|
|
["Explain Statement" sqlplus-explain sqlplus-connect-string]
|
|
["Evaluate Statement (HTML)" sqlplus-send-current-html sqlplus-connect-string]
|
|
["Evaluate Region" sqlplus-send-region (and (mark) sqlplus-connect-string)]))
|
|
(when orcl-mode
|
|
(list
|
|
"----"
|
|
["Send Commit" sqlplus-send-commit sqlplus-connect-string]
|
|
["Send Rollback" sqlplus-send-rollback sqlplus-connect-string]
|
|
["Restart Connection" sqlplus-restart-connection sqlplus-connect-string]
|
|
["Show History" sqlplus-show-history sqlplus-connect-string]
|
|
["Get Source from DB" sqlplus-get-source sqlplus-connect-string]
|
|
["Interrupt Evaluation" sqlplus-send-interrupt sqlplus-connect-string]
|
|
["Compare schema to filesystem" sqlplus-compare-schema-to-filesystem sqlplus-connect-string]
|
|
"----"
|
|
(list "Output"
|
|
["Show window" sqlplus-buffer-display-window t]
|
|
"----"
|
|
["Redisplay" sqlplus-buffer-redisplay-current t]
|
|
["Previous" sqlplus-buffer-prev-command t]
|
|
["Next" sqlplus-buffer-next-command t]
|
|
"----"
|
|
["Scroll Right" sqlplus-buffer-scroll-right t]
|
|
["Scroll Left" sqlplus-buffer-scroll-left t]
|
|
["Scroll Down" sqlplus-buffer-scroll-down t]
|
|
["Scroll Up" sqlplus-buffer-scroll-up t]
|
|
"----"
|
|
["Bottom" sqlplus-buffer-bottom t]
|
|
["Top" sqlplus-buffer-top t]
|
|
"----"
|
|
["Erase" sqlplus-buffer-erase t])
|
|
))
|
|
(when inactive-connect-strings
|
|
(append
|
|
(list "----")
|
|
(list (append (list "Recent Connections")
|
|
(mapcar (lambda (connect-string)
|
|
(vector connect-string (list 'apply ''sqlplus
|
|
(list 'sqlplus-read-connect-string connect-string)) t)) inactive-connect-strings)))))
|
|
(when active-connect-strings
|
|
(append
|
|
(list "----")
|
|
(mapcar (lambda (connect-string)
|
|
(vector connect-string (list 'apply ''sqlplus
|
|
(list 'sqlplus-read-connect-string connect-string)) t)) active-connect-strings)))
|
|
))
|
|
(error (message (error-message-string err)))))
|
|
|
|
(defun sqlplus-send-commit ()
|
|
"Send 'commit' command to SQL*Process."
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(sqlplus-execute sqlplus-connect-string "commit;" nil nil))
|
|
|
|
(defun sqlplus-send-rollback ()
|
|
"Send 'rollback' command to SQL*Process."
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(sqlplus-execute sqlplus-connect-string "rollback;" nil nil))
|
|
|
|
(defun sqlplus-show-history ()
|
|
"Show command history for current connection."
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(sqlplus-verify-buffer sqlplus-connect-string)
|
|
(switch-to-buffer (sqlplus-get-history-buffer sqlplus-connect-string)))
|
|
|
|
(defun sqlplus-restart-connection ()
|
|
"Kill SQL*Plus process and start again."
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(sqlplus-verify-buffer sqlplus-connect-string)
|
|
(let ((connect-stringos sqlplus-connect-string))
|
|
(unwind-protect
|
|
(progn
|
|
(setq sqlplus-kill-function-inhibitor t)
|
|
(sqlplus-shutdown connect-stringos t))
|
|
(setq sqlplus-kill-function-inhibitor nil))
|
|
(sqlplus connect-stringos (sqlplus-get-input-buffer-name connect-stringos))))
|
|
|
|
(define-skeleton plsql-begin
|
|
"begin..end skeleton"
|
|
"" ; interactor
|
|
"begin" ?\n
|
|
> _ ?\n
|
|
"end;" >)
|
|
|
|
(define-skeleton plsql-loop
|
|
"loop..end loop skeleton"
|
|
"" ; interactor
|
|
"loop" ?\n
|
|
> _ ?\n
|
|
"end loop;" >)
|
|
|
|
(define-skeleton plsql-if
|
|
"if..end if skeleton"
|
|
"" ; interactor
|
|
"if " _ " then" ?\n
|
|
> ?\n
|
|
"end if;" >)
|
|
|
|
;;; SQLPLUS-mode Keymap -
|
|
|
|
(unless orcl-mode-map
|
|
(setq orcl-mode-map (make-sparse-keymap))
|
|
(define-key orcl-mode-map "\C-c\C-o" 'sqlplus-buffer-display-window)
|
|
(define-key orcl-mode-map "\C-c\C-l" 'sqlplus-buffer-redisplay-current)
|
|
(define-key orcl-mode-map "\C-c\C-p" 'sqlplus-buffer-prev-command)
|
|
(define-key orcl-mode-map [C-S-up] 'sqlplus-buffer-prev-command)
|
|
(define-key orcl-mode-map "\C-c\C-n" 'sqlplus-buffer-next-command)
|
|
(define-key orcl-mode-map [C-S-down] 'sqlplus-buffer-next-command)
|
|
(define-key orcl-mode-map "\C-c\C-b" 'sqlplus-buffer-scroll-right)
|
|
(define-key orcl-mode-map [C-S-left] 'sqlplus-buffer-scroll-right)
|
|
(define-key orcl-mode-map "\C-c\C-f" 'sqlplus-buffer-scroll-left)
|
|
(define-key orcl-mode-map [C-S-right] 'sqlplus-buffer-scroll-left)
|
|
(define-key orcl-mode-map "\C-c\M-v" 'sqlplus-buffer-scroll-down)
|
|
(define-key orcl-mode-map "\C-c\C-v" 'sqlplus-buffer-scroll-up)
|
|
(define-key orcl-mode-map "\C-c>" 'sqlplus-buffer-bottom)
|
|
(define-key orcl-mode-map "\C-c<" 'sqlplus-buffer-top)
|
|
(define-key orcl-mode-map "\C-c\C-w" 'sqlplus-buffer-erase)
|
|
(define-key orcl-mode-map "\C-c\C-m" 'sqlplus-send-commit)
|
|
(define-key orcl-mode-map "\C-c\C-a" 'sqlplus-send-rollback)
|
|
(define-key orcl-mode-map "\C-c\C-k" 'sqlplus-restart-connection)
|
|
(define-key orcl-mode-map "\C-c\C-t" 'sqlplus-show-history)
|
|
(define-key orcl-mode-map "\C-c\C-s" 'sqlplus-get-source)
|
|
(define-key orcl-mode-map "\C-c\C-i" 'sqlplus-send-interrupt)
|
|
(define-key orcl-mode-map [S-return] 'sqlplus-send-user-string)
|
|
(define-key orcl-mode-map [tool-bar sqlplus-restart-connection]
|
|
(list 'menu-item "Restart connection" 'sqlplus-restart-connection :image sqlplus-kill-image))
|
|
(define-key orcl-mode-map [tool-bar sqlplus-cancel]
|
|
(list 'menu-item "Cancel" 'sqlplus-send-interrupt :image sqlplus-cancel-image))
|
|
(define-key orcl-mode-map [tool-bar sqlplus-rollback]
|
|
(list 'menu-item "Rollback" 'sqlplus-send-rollback :image sqlplus-rollback-image))
|
|
(define-key orcl-mode-map [tool-bar sqlplus-commit]
|
|
(list 'menu-item "Commit" 'sqlplus-send-commit :image sqlplus-commit-image)))
|
|
|
|
(unless sqlplus-mode-map
|
|
(setq sqlplus-mode-map (make-sparse-keymap))
|
|
(define-key sqlplus-mode-map "\C-c\C-g" 'plsql-begin)
|
|
(define-key sqlplus-mode-map "\C-c\C-q" 'plsql-loop)
|
|
(define-key sqlplus-mode-map "\C-c\C-z" 'plsql-if)
|
|
(define-key sqlplus-mode-map "\C-c\C-r" 'sqlplus-send-region)
|
|
(define-key sqlplus-mode-map [C-return] 'sqlplus-send-current)
|
|
(define-key sqlplus-mode-map [M-return] 'sqlplus-explain)
|
|
(define-key sqlplus-mode-map "\C-c\C-e" 'sqlplus-send-current)
|
|
(define-key sqlplus-mode-map "\C-c\C-j" 'sqlplus-send-current-html)
|
|
(define-key sqlplus-mode-map [C-S-return] 'sqlplus-send-current-html)
|
|
(define-key sqlplus-mode-map "\M-." 'sqlplus-file-get-source)
|
|
(define-key sqlplus-mode-map [C-down-mouse-1] 'sqlplus-mouse-select-identifier)
|
|
(define-key sqlplus-mode-map [C-mouse-1] 'sqlplus-file-get-source-mouse)
|
|
)
|
|
|
|
(easy-menu-add-item nil nil sqlplus-connections-menu t)
|
|
|
|
(unless sqlplus-mode-syntax-table
|
|
(setq sqlplus-mode-syntax-table (make-syntax-table))
|
|
(modify-syntax-entry ?/ ". 14" sqlplus-mode-syntax-table) ; comment start
|
|
(modify-syntax-entry ?* ". 23" sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?+ "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?. "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?\" "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?\\ "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?- ". 12b" sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?\n "> b" sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?= "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?% "w" sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?< "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?> "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?& "w" sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?| "." sqlplus-mode-syntax-table)
|
|
(modify-syntax-entry ?_ "w" sqlplus-mode-syntax-table) ; _ is word char
|
|
(modify-syntax-entry ?\' "\"" sqlplus-mode-syntax-table))
|
|
|
|
;;; SQL*Plus mode
|
|
|
|
(defun connect-string-to-string ()
|
|
(let ((txt (or (car (refine-connect-string sqlplus-connect-string)) "disconnected"))
|
|
(result))
|
|
(if (string-match "^\\(.*?\\)\\(\\w*prod\\w*\\)$" txt)
|
|
(if (>= emacs-major-version 22)
|
|
(setq result (list (list :propertize (substring txt 0 (match-beginning 2)) 'face '((:foreground "blue")))
|
|
(list :propertize (substring txt (match-beginning 2)) 'face '((:foreground "red")(:weight bold)))))
|
|
(setq result (setq txt (propertize txt 'face '((:foreground "blue")))))
|
|
(put-text-property (match-beginning 2) (match-end 2) 'face '((:foreground "red")(:weight bold)) txt))
|
|
(setq result
|
|
(if (>= emacs-major-version 22)
|
|
(list :propertize txt 'face '((:foreground "blue")))
|
|
(setq txt (propertize txt 'face '((:foreground "blue")))))))
|
|
result))
|
|
|
|
(defun sqlplus-font-lock (type-symbol limit)
|
|
(let ((sqlplus-font-lock-regexps (sqlplus-get-font-lock-regexps)))
|
|
(when sqlplus-font-lock-regexps
|
|
(let ((regexp (gethash type-symbol sqlplus-font-lock-regexps)))
|
|
(when regexp
|
|
(re-search-forward regexp limit t))))))
|
|
|
|
;; Local in input buffer (sqlplus-mode)
|
|
(defvar sqlplus-command-overlay nil)
|
|
(make-variable-buffer-local 'sqlplus-command-overlay)
|
|
(defvar sqlplus-begin-command-overlay-arrow-position nil)
|
|
(make-variable-buffer-local 'sqlplus-begin-command-overlay-arrow-position)
|
|
(defvar sqlplus-end-command-overlay-arrow-position nil)
|
|
(make-variable-buffer-local 'sqlplus-end-command-overlay-arrow-position)
|
|
|
|
(defun sqlplus-highlight-current-sqlplus-command()
|
|
(when (and window-system sqlplus-command-highlighting-style)
|
|
(let* ((pair (sqlplus-mark-current))
|
|
(begin (and (car pair) (save-excursion (goto-char (car pair)) (skip-chars-forward " \t\n") (point))))
|
|
(end (and (cdr pair) (save-excursion (goto-char (cdr pair)) (skip-chars-backward " \t\n") (beginning-of-line) (point))))
|
|
(point-line-beg (save-excursion (beginning-of-line) (point)))
|
|
(overlay-begin begin)
|
|
(overlay-end end))
|
|
(when (and begin end)
|
|
(when (< end point-line-beg)
|
|
(save-excursion (goto-char point-line-beg) (when (eobp) (insert "\n")))
|
|
(setq end point-line-beg)
|
|
(setq overlay-end end))
|
|
(when (or (>= begin end) (< (point) begin))
|
|
(when (or (< (point) begin) (> begin end))
|
|
(setq overlay-begin nil
|
|
overlay-end nil))
|
|
(setq begin nil
|
|
end nil)))
|
|
(if (and overlay-begin overlay-end (memq sqlplus-command-highlighting-style '(background fringe-and-background)))
|
|
(progn
|
|
(setq overlay-end (save-excursion
|
|
(goto-char overlay-end)
|
|
(beginning-of-line 2)
|
|
(point)))
|
|
(move-overlay sqlplus-command-overlay overlay-begin overlay-end))
|
|
(move-overlay sqlplus-command-overlay 1 1))
|
|
(if (memq sqlplus-command-highlighting-style '(fringe fringe-and-background))
|
|
(progn
|
|
(put 'sqlplus-begin-command-overlay-arrow-position 'overlay-arrow-bitmap 'top-left-angle)
|
|
(put 'sqlplus-end-command-overlay-arrow-position 'overlay-arrow-bitmap 'bottom-left-angle)
|
|
(set-marker sqlplus-begin-command-overlay-arrow-position begin)
|
|
(set-marker sqlplus-end-command-overlay-arrow-position end))
|
|
(set-marker sqlplus-begin-command-overlay-arrow-position nil)
|
|
(set-marker sqlplus-end-command-overlay-arrow-position nil)))))
|
|
|
|
(defun sqlplus-find-begin-of-sqlplus-command ()
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(while (and (not (bobp)) (save-excursion (end-of-line 0) (skip-chars-backward " \t") (equal (char-before) ?-)))
|
|
(beginning-of-line 0))
|
|
(point)))
|
|
|
|
(defun sqlplus-find-end-of-sqlplus-command ()
|
|
(save-excursion
|
|
(end-of-line)
|
|
(while (progn (skip-chars-backward " \t") (and (not (eobp)) (equal (char-before) ?-)))
|
|
(end-of-line 2))
|
|
(point)))
|
|
|
|
(defun sqlplus-set-font-lock-emacs-structures-for-level (level mode-symbol)
|
|
(let ((result (append sql-mode-oracle-font-lock-keywords
|
|
(default-value (cond ((equal level 3) 'sqlplus-font-lock-keywords-3)
|
|
((equal level 2) 'sqlplus-font-lock-keywords-2)
|
|
((equal level 1) 'sqlplus-font-lock-keywords-1)
|
|
(t nil))))))
|
|
(when (featurep 'plsql)
|
|
(setq result (append (symbol-value 'plsql-oracle-font-lock-fix-re) result)))
|
|
(setq result
|
|
(append
|
|
;; Names for schemas, tables, synonyms, views, columns, sequences, packages, triggers and indexes
|
|
(when (> level 2)
|
|
(mapcar (lambda (pair)
|
|
(let ((type-symbol (car pair))
|
|
(face (cadr pair)))
|
|
(cons (eval `(lambda (limit) (sqlplus-font-lock ',type-symbol limit))) face)))
|
|
sqlplus-syntax-faces))
|
|
;; SQL*Plus
|
|
(when (eq mode-symbol 'sqlplus-mode)
|
|
(unless sqlplus-commands-regexp-1
|
|
(flet ((first-form-fun (cmds) (mapcar (lambda (name) (car (sqlplus-full-forms name))) cmds))
|
|
(all-forms-fun (cmds) (mapcan 'sqlplus-full-forms cmds))
|
|
(sqlplus-commands-regexp-fun (form-fun cmds) (concat "^" (regexp-opt (funcall form-fun cmds) t) "\\b"))
|
|
(sqlplus-system-variables-fun (form-fun vars) (concat "\\b" (regexp-opt (funcall form-fun vars) t) "\\b")))
|
|
(flet ((sqlplus-v22-commands-font-lock-keywords-fun
|
|
(form-fun)
|
|
(delq nil
|
|
(mapcar
|
|
(lambda (command-info)
|
|
(let* ((names (car command-info))
|
|
(names-list (if (listp names) names (list names)))
|
|
(sublists (cdr command-info)))
|
|
(when sublists
|
|
(append (list (sqlplus-commands-regexp-fun form-fun names-list))
|
|
(mapcar (lambda (sublist)
|
|
(let ((face (car sublist))
|
|
(regexp (concat "\\b"
|
|
(regexp-opt (mapcan (lambda (name) (sqlplus-full-forms name))
|
|
(mapcan (lambda (elem)
|
|
(if (symbolp elem)
|
|
(copy-list (symbol-value elem))
|
|
(list elem)))
|
|
(cdr sublist)))
|
|
t)
|
|
"\\b")))
|
|
(list regexp '(sqlplus-find-end-of-sqlplus-command) nil (list 1 face))))
|
|
sublists)
|
|
(list '("\\(\\w+\\)" (sqlplus-find-end-of-sqlplus-command) nil (1 font-lock-sqlplus-face)))))))
|
|
sqlplus-commands))))
|
|
(let ((commands (mapcan
|
|
(lambda (command-info) (let ((names (car command-info))) (if (listp names) (copy-list names) (list names))))
|
|
sqlplus-commands)))
|
|
(setq sqlplus-commands-regexp-1 (sqlplus-commands-regexp-fun 'first-form-fun commands))
|
|
(setq sqlplus-commands-regexp-23 (sqlplus-commands-regexp-fun 'all-forms-fun commands))
|
|
(if (<= emacs-major-version 21)
|
|
(setq sqlplus-system-variables-regexp-1 (sqlplus-system-variables-fun 'first-form-fun sqlplus-system-variables)
|
|
sqlplus-system-variables-regexp-23 (sqlplus-system-variables-fun 'all-forms-fun sqlplus-system-variables))
|
|
(setq sqlplus-v22-commands-font-lock-keywords-1 (sqlplus-v22-commands-font-lock-keywords-fun 'first-form-fun)
|
|
sqlplus-v22-commands-font-lock-keywords-23 (sqlplus-v22-commands-font-lock-keywords-fun 'all-forms-fun)))))))
|
|
(append (list
|
|
;; Comments (REM command)
|
|
(cons "^\\(rem\\)\\b\\(.*?\\)$" '((1 font-lock-keyword-face nil nil) (2 font-lock-comment-face t nil)))
|
|
;; Predefined SQL*Plus variables
|
|
(cons (concat "\\b"
|
|
(regexp-opt '("_CONNECT_IDENTIFIER" "_DATE" "_EDITOR" "_O_VERSION" "_O_RELEASE" "_PRIVILEGE"
|
|
"_SQLPLUS_RELEASE" "_USER") t)
|
|
"\\b")
|
|
'font-lock-builtin-face)
|
|
;; SQL*Plus commands (+ shortcuts if level >= 2)
|
|
(cons
|
|
(concat (if (>= level 2) sqlplus-commands-regexp-23 sqlplus-commands-regexp-1) "\\|^\\(@@\\|@\\|!\\|/\\|\\$\\)" )
|
|
'font-lock-keyword-face))
|
|
(if (<= emacs-major-version 21)
|
|
;; SQL*Plus system variables (+ shortcuts if level >= 2)
|
|
(list (cons (if (>= level 2) sqlplus-system-variables-regexp-23 sqlplus-system-variables-regexp-1) 'font-lock-builtin-face))
|
|
;; ver. >= 22
|
|
(if (>= level 2) sqlplus-v22-commands-font-lock-keywords-23 sqlplus-v22-commands-font-lock-keywords-1))))
|
|
; (cons "\\b\\([a-zA-Z$_#0-9]+\\)\\b\\.\\(\\b[a-zA-Z$_#0-9]+\\b\\)" '((1 font-lock-type-face nil nil)(2 font-lock-variable-name-face nil nil)))
|
|
(list
|
|
;; Extra Oracle syntax highlighting, not recognized by sql-mode or plsql-mode
|
|
(cons sqlplus-oracle-extra-types-re 'font-lock-type-face)
|
|
(cons sqlplus-oracle-extra-warning-words-re 'font-lock-warning-face)
|
|
(cons sqlplus-oracle-extra-types-re 'font-lock-type-face)
|
|
(cons sqlplus-oracle-extra-keywords-re 'font-lock-keyword-face)
|
|
(cons sqlplus-oracle-plsql-extra-reserved-words-re 'font-lock-keyword-face)
|
|
(if (string-match "XEmacs\\|Lucid" emacs-version)
|
|
(cons sqlplus-oracle-extra-pseudocolumns-re 'font-lock-preprocessor-face)
|
|
(cons sqlplus-oracle-extra-pseudocolumns-re 'font-lock-builtin-face))
|
|
(if (string-match "XEmacs\\|Lucid" emacs-version)
|
|
(cons sqlplus-oracle-extra-builtin-functions-re 'font-lock-preprocessor-face)
|
|
(cons sqlplus-oracle-extra-builtin-functions-re 'font-lock-builtin-face))
|
|
;; SQL*Plus variable names, like '&name' or '&&name'
|
|
(cons "\\(\\b&[&a-zA-Z$_#0-9]+\\b\\)" 'font-lock-variable-name-face))
|
|
result
|
|
;; Function calls
|
|
(when (>= level 2)
|
|
(list (cons "\\b\\(\\([a-zA-Z$_#0-9]+\\b\\)\\.\\)?\\(\\b[a-zA-Z$_#0-9]+\\b\\)\\s-*("
|
|
'((2 font-lock-type-face nil t)
|
|
(3 font-lock-function-name-face nil nil)))))))
|
|
result))
|
|
|
|
(defun sqlplus-mode nil
|
|
"Mode for editing and executing SQL*Plus commands. Entry into this mode runs the hook
|
|
'sqlplus-mode-hook'.
|
|
|
|
Use \\[sqlplus] to start the SQL*Plus interpreter.
|
|
|
|
Just position the cursor on or near the SQL*Plus statement you
|
|
wish to send and press '\\[sqlplus-send-current]' to run it and
|
|
display the results.
|
|
|
|
Mode Specific Bindings:
|
|
|
|
\\{sqlplus-mode-map}"
|
|
(interactive)
|
|
(run-hooks 'change-major-mode-hook)
|
|
(setq major-mode 'sqlplus-mode
|
|
mode-name "SQL*Plus")
|
|
(use-local-map sqlplus-mode-map)
|
|
(set-syntax-table sqlplus-mode-syntax-table)
|
|
(make-local-variable 'comment-start)
|
|
(make-local-variable 'comment-end)
|
|
(setq comment-start "/* "
|
|
comment-end " */")
|
|
(orcl-mode 1)
|
|
(setq sqlplus-font-lock-keywords-1 (sqlplus-set-font-lock-emacs-structures-for-level 1 major-mode)
|
|
sqlplus-font-lock-keywords-2 (sqlplus-set-font-lock-emacs-structures-for-level 2 major-mode)
|
|
sqlplus-font-lock-keywords-3 (sqlplus-set-font-lock-emacs-structures-for-level 3 major-mode))
|
|
(when (featurep 'plsql)
|
|
(set (make-local-variable 'indent-line-function)
|
|
(lambda () (interactive) (condition-case err (funcall (symbol-function 'plsql-indent)) (error (message "Error: %S" err)))))
|
|
(set (make-local-variable 'indent-region-function) 'plsql-indent-region)
|
|
(set (make-local-variable 'align-mode-rules-list) 'plsql-align-rules-list))
|
|
(setq font-lock-defaults sqlplus-font-lock-defaults)
|
|
(unless sqlplus-connect-string
|
|
(let ((potential-connect-string (sqlplus-get-potential-connect-string (buffer-file-name))))
|
|
(when (and potential-connect-string
|
|
(get-process (sqlplus-get-process-name potential-connect-string)))
|
|
(setq sqlplus-connect-string potential-connect-string))))
|
|
(set (make-local-variable 'font-lock-extend-after-change-region-function)
|
|
(lambda (beg end old-len)
|
|
(cons (save-excursion (goto-char beg) (sqlplus-find-begin-of-sqlplus-command))
|
|
(save-excursion (goto-char end) (sqlplus-find-end-of-sqlplus-command)))))
|
|
(unless font-lock-sqlplus-face
|
|
(copy-face 'default 'font-lock-sqlplus-face)
|
|
(setq font-lock-sqlplus-face 'font-lock-sqlplus-face))
|
|
(turn-on-font-lock)
|
|
(unless frame-background-mode
|
|
(setq frame-background-mode (if (< (sqlplus-color-percentage (face-background 'default)) 50) 'dark 'light)))
|
|
(setq imenu-generic-expression '((nil "^--[ ]*\\([^;.\n]*\\)" 1)))
|
|
;; if input buffer has sqlplus-mode then prepare it for command under cursor selection
|
|
(when (and (eq major-mode 'sqlplus-mode) (null sqlplus-begin-command-overlay-arrow-position))
|
|
(setq sqlplus-begin-command-overlay-arrow-position (make-marker)
|
|
sqlplus-end-command-overlay-arrow-position (make-marker)
|
|
sqlplus-command-overlay (make-overlay 1 1))
|
|
(overlay-put sqlplus-command-overlay 'face 'sqlplus-command-highlight-face)
|
|
(when (and (>= emacs-major-version 22) (not (memq 'sqlplus-begin-command-overlay-arrow-position overlay-arrow-variable-list)))
|
|
(push 'sqlplus-begin-command-overlay-arrow-position overlay-arrow-variable-list))
|
|
(when (and (>= emacs-major-version 22) (not (memq 'sqlplus-end-command-overlay-arrow-position overlay-arrow-variable-list)))
|
|
(push 'sqlplus-end-command-overlay-arrow-position overlay-arrow-variable-list))
|
|
(add-hook 'pre-command-hook (lambda ()
|
|
(set-marker sqlplus-begin-command-overlay-arrow-position nil)
|
|
(set-marker sqlplus-end-command-overlay-arrow-position nil))
|
|
nil t)
|
|
(add-hook 'post-command-hook (lambda ()
|
|
(sqlplus-clear-mouse-selection)
|
|
(set-marker sqlplus-begin-command-overlay-arrow-position nil)
|
|
(set-marker sqlplus-end-command-overlay-arrow-position nil))
|
|
nil t))
|
|
(run-hooks 'sqlplus-mode-hook))
|
|
|
|
(defun sqlplus-color-percentage (color)
|
|
(truncate (* (/ (/ (reduce '+ (color-values color)) 3.0) 65535.0) 100.0)))
|
|
|
|
(defun sqlplus-get-potential-connect-string (file-path)
|
|
(when file-path
|
|
(let* ((file-name (file-name-nondirectory file-path))
|
|
(extension (file-name-extension file-name))
|
|
(case-fold-search t))
|
|
(when (and extension
|
|
(string-match (concat "^" sqlplus-session-file-extension "$") extension)
|
|
(string-match "@" file-name))
|
|
(car (refine-connect-string (file-name-sans-extension file-name)))))))
|
|
|
|
(defun sqlplus-check-connection ()
|
|
(if orcl-mode
|
|
(unless sqlplus-connect-string
|
|
(let* ((potential-connect-string (sqlplus-get-potential-connect-string (buffer-file-name)))
|
|
(connect-string (car (sqlplus-read-connect-string nil (or potential-connect-string
|
|
(caar (sqlplus-divide-connect-strings)))))))
|
|
(sqlplus connect-string (buffer-name))))
|
|
(error "Current buffer is not determined to communicate with Oracle")))
|
|
|
|
;;; Utilitities
|
|
|
|
(defun sqlplus-echo-in-buffer (buffer-name string &optional force-display hide-after-head)
|
|
"Displays string in the named buffer, creating the buffer if needed. If force-display is true, the buffer will appear
|
|
if not already shown."
|
|
(let ((buffer (get-buffer buffer-name)))
|
|
(when buffer
|
|
(if force-display (display-buffer buffer))
|
|
(with-current-buffer buffer
|
|
(while (and (> (buffer-size) sqlplus-output-buffer-max-size)
|
|
(progn (goto-char (point-min))
|
|
(unless (eobp) (forward-char))
|
|
(re-search-forward (concat "^" (regexp-quote sqlplus-output-separator)) nil t)))
|
|
(delete-region 1 (- (point) (length sqlplus-output-separator))))
|
|
|
|
(goto-char (point-max))
|
|
(let ((start-point (point)))
|
|
(insert string)
|
|
(when hide-after-head
|
|
(let ((from-pos (string-match "\n" string))
|
|
(keymap (make-sparse-keymap))
|
|
overlay)
|
|
(when from-pos
|
|
(setq overlay (make-overlay (+ start-point from-pos) (- (+ start-point (length string)) 2)))
|
|
(when (or (not (consp buffer-invisibility-spec))
|
|
(not (assq 'hide-symbol buffer-invisibility-spec)))
|
|
(add-to-invisibility-spec '(hide-symbol . t)))
|
|
(overlay-put overlay 'invisible 'hide-symbol)
|
|
(put-text-property start-point (- (+ start-point (length string)) 2) 'help-echo string)
|
|
(put-text-property start-point (- (+ start-point (length string)) 2) 'mouse-face 'highlight)
|
|
(put-text-property start-point (- (+ start-point (length string)) 2) 'keymap sqlplus-output-buffer-keymap)))))
|
|
(if force-display
|
|
(set-window-point (get-buffer-window buffer-name) (point-max)))))))
|
|
|
|
(defun sqlplus-verify-buffer (connect-string)
|
|
(let ((output-buffer-name (sqlplus-get-output-buffer-name connect-string))
|
|
(process-buffer-name (sqlplus-get-process-buffer-name connect-string)))
|
|
(when (not (get-buffer process-buffer-name))
|
|
(sqlplus-shutdown connect-string)
|
|
(error "No SQL*Plus session! Use 'M-x sqlplus' to start the SQL*Plus interpreter"))
|
|
(unless (get-buffer-process process-buffer-name)
|
|
(sqlplus-shutdown connect-string)
|
|
(error "Buffer '%s' is not talking to anybody!" output-buffer-name)))
|
|
t)
|
|
|
|
(defun sqlplus-get-context (connect-string &optional id)
|
|
(let ((process-buffer (sqlplus-get-process-buffer-name connect-string)))
|
|
(when process-buffer
|
|
(with-current-buffer process-buffer
|
|
(when id
|
|
(while (and sqlplus-command-contexts
|
|
(not (equal (sqlplus-get-context-value (car sqlplus-command-contexts) :id) id)))
|
|
(setq sqlplus-command-contexts (cdr sqlplus-command-contexts))))
|
|
(car sqlplus-command-contexts)))))
|
|
|
|
(defun sqlplus-get-context-value (context var-symbol)
|
|
(cdr (assq var-symbol context)))
|
|
|
|
(defun sqlplus-set-context-value (context var-symbol value)
|
|
(let ((association (assq var-symbol context)))
|
|
(if association
|
|
(setcdr association value)
|
|
(setcdr context (cons (cons var-symbol value) (cdr context))))
|
|
context))
|
|
|
|
(defun sqlplus-mark-current ()
|
|
"Marks the current SQL for sending to the SQL*Plus process. Marks are placed around a region defined by empty lines."
|
|
(let (begin end empty-line-p empty-line-p next-line-included tail-p)
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(setq empty-line-p (when (looking-at "^[ \t]*\\(\n\\|\\'\\)") (point)))
|
|
(setq next-line-included (and empty-line-p (save-excursion (skip-chars-forward " \t\n") (> (current-column) 0))))
|
|
(setq tail-p (and empty-line-p
|
|
(or (bobp) (save-excursion (beginning-of-line 0) (looking-at "^[ \t]*\n"))))))
|
|
(unless tail-p
|
|
(save-excursion
|
|
(end-of-line)
|
|
(re-search-backward "\\`\\|\n[\r\t ]*\n[^ \t]" nil t)
|
|
(skip-syntax-forward "-")
|
|
(setq begin (point)))
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(re-search-forward "\n[\r\t ]*\n[^ \t]\\|\\'" nil t)
|
|
(unless (zerop (length (match-string 0)))
|
|
(backward-char 1))
|
|
(skip-syntax-backward "-")
|
|
(setq end (or (and (not next-line-included) empty-line-p) (point)))))
|
|
(cons begin end)))
|
|
|
|
;;; Transmission Commands
|
|
|
|
(defun sqlplus-send-current (arg &optional html)
|
|
"Send the current SQL command(s) to the SQL*Plus process. With argument, show results in raw form."
|
|
(interactive "P")
|
|
(sqlplus-check-connection)
|
|
(when (buffer-file-name)
|
|
(condition-case err
|
|
(save-buffer)
|
|
(error (message (error-message-string err)))))
|
|
(let ((region (sqlplus-mark-current)))
|
|
(setq sqlplus-region-beginning-pos (car region)
|
|
sqlplus-region-end-pos (cdr region)))
|
|
(if (and sqlplus-region-beginning-pos sqlplus-region-end-pos)
|
|
(sqlplus-send-region arg sqlplus-region-beginning-pos sqlplus-region-end-pos nil html)
|
|
(error "Point doesn't indicate any command to execute")))
|
|
|
|
(defun sqlplus-send-current-html (arg)
|
|
(interactive "P")
|
|
(sqlplus-send-current arg t))
|
|
|
|
|
|
;;; SQLPLUS-Output Buffer Operations -
|
|
|
|
(defun sqlplus--show-buffer (connect-string fcn args)
|
|
(let* ((output-buffer-name (sqlplus-get-output-buffer-name connect-string)))
|
|
(sqlplus-verify-buffer connect-string)
|
|
(if sqlplus-suppress-show-output-buffer
|
|
(with-current-buffer (get-buffer output-buffer-name)
|
|
(if fcn (condition-case err (apply fcn args) (error (message (error-message-string err))))))
|
|
(if (not (eq (window-buffer (selected-window)) (get-buffer output-buffer-name)))
|
|
(switch-to-buffer-other-window output-buffer-name))
|
|
(if fcn (condition-case err (apply fcn args) (error (message (error-message-string err))))))))
|
|
|
|
(defun sqlplus-show-buffer (&optional connect-string fcn &rest args)
|
|
"Makes the SQL*Plus output buffer visible in the other window."
|
|
(interactive)
|
|
(setq connect-string (or connect-string sqlplus-connect-string))
|
|
(unless connect-string
|
|
(error "Current buffer is disconnected!"))
|
|
(let ((output-buffer-name (sqlplus-get-output-buffer-name connect-string)))
|
|
(if (and output-buffer-name
|
|
(eq (current-buffer) (get-buffer output-buffer-name)))
|
|
(sqlplus--show-buffer connect-string fcn args)
|
|
(save-excursion
|
|
(save-selected-window
|
|
(sqlplus--show-buffer connect-string fcn args))))))
|
|
|
|
(fset 'sqlplus-buffer-display-window 'sqlplus-show-buffer)
|
|
|
|
(defun sqlplus-buffer-scroll-up (&optional connect-string)
|
|
"Scroll-up in the SQL*Plus output buffer window."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'scroll-up))
|
|
|
|
(defun sqlplus-buffer-scroll-down (&optional connect-string)
|
|
"Scroll-down in the SQL*Plus output buffer window."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'scroll-down))
|
|
|
|
(defun sqlplus-scroll-left (num)
|
|
(call-interactively 'scroll-left))
|
|
|
|
(defun sqlplus-scroll-right (num)
|
|
(call-interactively 'scroll-right))
|
|
|
|
(defun sqlplus-buffer-scroll-left (num &optional connect-string)
|
|
"Scroll-left in the SQL*Plus output buffer window."
|
|
(interactive "p")
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-scroll-left (* num (/ (window-width) 2))))
|
|
|
|
(defun sqlplus-buffer-scroll-right (num &optional connect-string)
|
|
"Scroll-right in the SQL*Plus output buffer window."
|
|
(interactive "p")
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-scroll-right (* num (/ (window-width) 2))))
|
|
|
|
(defun sqlplus-buffer-mark-current (&optional connect-string)
|
|
"Mark the current position in the SQL*Plus output window."
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-buffer-make-mark))
|
|
|
|
(defun sqlplus-buffer-make-mark (&optional connect-string)
|
|
"Set the sqlplus-buffer-marker."
|
|
(setq sqlplus-buffer-mark (copy-marker (point))))
|
|
|
|
(defun sqlplus-buffer-redisplay-current (&optional connect-string)
|
|
"Go to the current sqlplus-buffer-mark."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-goto-mark))
|
|
|
|
(defun sqlplus-goto-mark ()
|
|
(goto-char sqlplus-buffer-mark)
|
|
(recenter 0))
|
|
|
|
(defun sqlplus-buffer-top (&optional connect-string)
|
|
"Goto the top of the SQL*Plus output buffer."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-beginning-of-buffer))
|
|
|
|
(defun sqlplus-beginning-of-buffer nil (goto-char (point-min)))
|
|
|
|
(defun sqlplus-buffer-bottom (&optional connect-string)
|
|
"Goto the bottom of the SQL*Plus output buffer."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-end-of-buffer))
|
|
|
|
(defun sqlplus-end-of-buffer nil (goto-char (point-max)) (unless sqlplus-suppress-show-output-buffer (recenter -1)))
|
|
|
|
(defun sqlplus-buffer-erase (&optional connect-string)
|
|
"Clear the SQL output buffer."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'erase-buffer))
|
|
|
|
(defun sqlplus-buffer-next-command (&optional connect-string)
|
|
"Search for the next command in the SQL*Plus output buffer."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-next-command))
|
|
|
|
(defun sqlplus-next-command nil
|
|
"Search for the next command in the SQL*Plus output buffer."
|
|
(cond ((re-search-forward (concat "^" (regexp-quote sqlplus-output-separator)) nil t)
|
|
(forward-line 2)
|
|
(recenter 0))
|
|
(t (beep) (message "No more commands."))))
|
|
|
|
(defun sqlplus-buffer-prev-command (&optional connect-string)
|
|
"Search for the previous command in the SQL*Plus output buffer."
|
|
(interactive)
|
|
(sqlplus-show-buffer (or connect-string sqlplus-connect-string) 'sqlplus-previous-command))
|
|
|
|
(defun sqlplus-previous-command nil
|
|
"Search for the previous command in the SQL*Plus output buffer."
|
|
(let ((start (point)))
|
|
(re-search-backward (concat "^" (regexp-quote sqlplus-output-separator)) nil t)
|
|
(cond ((re-search-backward (concat "^" (regexp-quote sqlplus-output-separator)) nil t)
|
|
(forward-line 2)
|
|
(recenter 0))
|
|
(t
|
|
(message "No more commands.") (beep)
|
|
(goto-char start)))))
|
|
|
|
(defun sqlplus-send-interrupt nil
|
|
"Send an interrupt the the SQL*Plus interpreter process."
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(let ((connect-string sqlplus-connect-string))
|
|
(sqlplus-verify-buffer connect-string)
|
|
(interrupt-process (get-process (sqlplus-get-process-name connect-string)))))
|
|
|
|
|
|
;;; SQL Interpreter
|
|
|
|
(defun refine-connect-string (connect-string &optional no-slash)
|
|
"Z connect stringa do SQL*Plusa wycina haslo, tj. np. 'ponaglenia/x@SID' -> ('ponaglenia@SID' . 'x')."
|
|
(let (result passwd)
|
|
(when connect-string
|
|
(setq result
|
|
(if (string-match "\\(\\`[^@/]*?\\)/\\([^/@:]*\\)\\(.*?\\'\\)" connect-string)
|
|
(progn
|
|
(setq passwd (match-string 2 connect-string))
|
|
(concat (match-string 1 connect-string) (match-string 3 connect-string)))
|
|
connect-string))
|
|
(when no-slash
|
|
(while (string-match "/" result)
|
|
(setq result (replace-match "!" nil t result)))))
|
|
(cons result passwd)))
|
|
|
|
(defun sqlplus-get-output-buffer-name (connect-string)
|
|
(concat "*" (car (refine-connect-string connect-string)) "*"))
|
|
|
|
(defun sqlplus-get-input-buffer-name (connect-string)
|
|
(concat (car (refine-connect-string connect-string)) (concat "." sqlplus-session-file-extension)))
|
|
|
|
(defun sqlplus-get-history-buffer-name (connect-string)
|
|
(concat " " (car (refine-connect-string connect-string)) "-hist"))
|
|
|
|
(defun sqlplus-get-process-buffer-name (connect-string)
|
|
(concat " " (car (refine-connect-string connect-string))))
|
|
|
|
(defun sqlplus-get-process-name (connect-string)
|
|
(car (refine-connect-string connect-string)))
|
|
|
|
(defun sqlplus-read-connect-string (&optional connect-string default-connect-string)
|
|
"Ask user for connect string with password, with DEFAULT-CONNECT-STRING proposed.
|
|
DEFAULT-CONNECT-STRING nil means first inactive connect-string on sqlplus-connect-strings-alist.
|
|
CONNECT-STRING non nil means ask for password only if CONNECT-STRING has no password itself.
|
|
Returns (qualified-connect-string refined-connect-string)."
|
|
(unless default-connect-string
|
|
(let ((inactive-connect-strings (cdr (sqlplus-divide-connect-strings))))
|
|
(setq default-connect-string
|
|
(some (lambda (pair)
|
|
(when (member (car pair) inactive-connect-strings) (car pair)))
|
|
sqlplus-connect-strings-alist))))
|
|
(let* ((cs (downcase (or connect-string
|
|
(read-string (format "Connect string%s: " (if default-connect-string (format " [default %s]" default-connect-string) ""))
|
|
nil 'sqlplus-connect-string-history default-connect-string))))
|
|
(pair (refine-connect-string cs))
|
|
(refined-cs (car pair))
|
|
(password (cdr pair))
|
|
(was-password password)
|
|
(association (assoc refined-cs sqlplus-connect-strings-alist)))
|
|
(unless (or password current-prefix-arg)
|
|
(setq password (cdr association)))
|
|
(unless password
|
|
(setq password (read-passwd (format "Password for %s: " cs))))
|
|
(unless was-password
|
|
(if (string-match "@" cs)
|
|
(setq cs (replace-match (concat "/" password "@") t t cs))
|
|
(setq cs (concat cs "/" password))))
|
|
(list cs refined-cs)))
|
|
|
|
(defun sqlplus (connect-string &optional input-buffer-name output-buffer-flag)
|
|
"Create SQL*Plus process connected to Oracle according to
|
|
CONNECT-STRING, open (or create) input buffer with specified
|
|
name (do not create if INPUT-BUFFER-NAME is nil).
|
|
OUTPUT-BUFFER-FLAG has meanings: nil or SHOW-OUTPUT-BUFFER -
|
|
create output buffer and show it, DONT-SHOW-OUTPUT-BUFFER -
|
|
create output buffer but dont show it, DONT-CREATE-OUTPUT-BUFFER
|
|
- dont create output buffer"
|
|
(interactive (let ((pair (sqlplus-read-connect-string)))
|
|
(list (car pair) (concat (cadr pair) (concat "." sqlplus-session-file-extension)))))
|
|
(set (make-local-variable 'comment-start-skip) "/\\*+ *\\|--+ *")
|
|
(set (make-local-variable 'comment-multi-line) t)
|
|
;; create sqlplus-session-cache-dir if not exists
|
|
(when sqlplus-session-cache-dir
|
|
(condition-case err
|
|
(unless (file-directory-p sqlplus-session-cache-dir)
|
|
(make-directory sqlplus-session-cache-dir t))
|
|
(error (message (error-message-string err)))))
|
|
(let* ((was-input-buffer (and input-buffer-name (get-buffer input-buffer-name)))
|
|
(input-buffer (or was-input-buffer
|
|
(when input-buffer-name
|
|
(if sqlplus-session-cache-dir
|
|
(let ((buf (find-file-noselect
|
|
(concat
|
|
(file-name-as-directory sqlplus-session-cache-dir)
|
|
(car (refine-connect-string connect-string t))
|
|
(concat "." sqlplus-session-file-extension)))))
|
|
(condition-case nil
|
|
(with-current-buffer buf
|
|
(rename-buffer input-buffer-name))
|
|
(error nil))
|
|
buf)
|
|
(get-buffer-create input-buffer-name)))))
|
|
(output-buffer (or (and (not (eq output-buffer-flag 'dont-create-output-buffer))
|
|
(get-buffer-create (sqlplus-get-output-buffer-name connect-string)))
|
|
(get-buffer (sqlplus-get-output-buffer-name connect-string))))
|
|
(process-name (sqlplus-get-process-name connect-string))
|
|
(process-buffer-name (sqlplus-get-process-buffer-name connect-string))
|
|
(was-process (get-process process-name))
|
|
process-created
|
|
(process (or was-process
|
|
(let (proc)
|
|
(puthash (car (refine-connect-string connect-string))
|
|
(make-sqlplus-global-struct :font-lock-regexps (make-hash-table :test 'equal)
|
|
:side-view-buffer (when (featurep 'ide-skel) (sqlplus-create-side-view-buffer connect-string)))
|
|
sqlplus-global-structures)
|
|
;; push current connect string to the beginning of sqlplus-connect-strings-alist
|
|
(let* ((refined-cs (refine-connect-string connect-string)))
|
|
(setq sqlplus-connect-strings-alist (delete* (car refined-cs) sqlplus-connect-strings-alist :test 'string= :key 'car))
|
|
(push refined-cs sqlplus-connect-strings-alist))
|
|
(sqlplus-get-history-buffer connect-string)
|
|
(when output-buffer
|
|
(with-current-buffer output-buffer
|
|
(erase-buffer)))
|
|
(setq process-created t
|
|
proc (start-process process-name process-buffer-name sqlplus-command connect-string))
|
|
(set-process-sentinel proc (lambda (process event)
|
|
(let ((proc-buffer (buffer-name (process-buffer process)))
|
|
(output-buffer (get-buffer (sqlplus-get-output-buffer-name (process-name process))))
|
|
err-msg
|
|
(exited-abnormally (string-match "\\`exited abnormally with code" event)))
|
|
(when output-buffer
|
|
(with-current-buffer output-buffer
|
|
(goto-char (point-max))
|
|
(insert (format "\n%s" event))
|
|
(when exited-abnormally
|
|
(setq sqlplus-connect-strings-alist
|
|
(delete* (car (refine-connect-string sqlplus-connect-string))
|
|
sqlplus-connect-strings-alist :test 'string= :key 'car))
|
|
(when proc-buffer
|
|
(with-current-buffer proc-buffer
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(when (re-search-forward "^ORA-[0-9]+.*$" nil t)
|
|
(setq err-msg (match-string 0))))
|
|
(erase-buffer)))
|
|
(when err-msg
|
|
(insert (concat "\n" err-msg)))))))))
|
|
(process-kill-without-query proc (not sqlplus-kill-processes-without-query-on-exit-flag))
|
|
(set-process-filter proc 'sqlplus-process-filter)
|
|
(with-current-buffer (get-buffer process-buffer-name)
|
|
(setq sqlplus-process-p connect-string))
|
|
proc))))
|
|
(when output-buffer
|
|
(with-current-buffer output-buffer
|
|
(orcl-mode 1)
|
|
(set (make-local-variable 'line-move-ignore-invisible) t)
|
|
(setq sqlplus-output-buffer-keymap (make-sparse-keymap)
|
|
sqlplus-connect-string connect-string
|
|
truncate-lines t)
|
|
(define-key sqlplus-output-buffer-keymap "\C-m" (lambda () (interactive) (sqlplus-output-buffer-hide-show)))
|
|
(define-key sqlplus-output-buffer-keymap [S-mouse-2] (lambda (event) (interactive "@e") (sqlplus-output-buffer-hide-show)))
|
|
(local-set-key [S-return] 'sqlplus-send-user-string)))
|
|
(when input-buffer
|
|
(with-current-buffer input-buffer
|
|
(setq sqlplus-connect-string connect-string)))
|
|
;; if input buffer was created then switch it to sqlplus-mode
|
|
(when (and input-buffer (not was-input-buffer))
|
|
(with-current-buffer input-buffer
|
|
(unless (eq major-mode 'sqlplus-mode)
|
|
(sqlplus-mode)))
|
|
(when font-lock-mode (font-lock-mode 1))
|
|
(set-window-buffer (sqlplus-get-workbench-window) input-buffer))
|
|
;; if process was created then get information for font lock
|
|
(when process-created
|
|
(sqlplus-execute connect-string nil nil (sqlplus-initial-strings) 'no-echo)
|
|
(let ((plsql-font-lock-level (sqlplus-font-lock-value-in-major-mode font-lock-maximum-decoration 'plsql-mode))
|
|
(sqlplus-font-lock-level (sqlplus-font-lock-value-in-major-mode font-lock-maximum-decoration 'sqlplus-mode)))
|
|
(when (or (equal plsql-font-lock-level t) (equal sqlplus-font-lock-level t)
|
|
(and (numberp plsql-font-lock-level) (>= plsql-font-lock-level 2))
|
|
(and (numberp sqlplus-font-lock-level) (>= sqlplus-font-lock-level 2)))
|
|
(sqlplus-hidden-select connect-string
|
|
(concat "select distinct column_name, 'COLUMN', ' ' from user_tab_columns where column_name not like 'BIN$%'\n"
|
|
"union\n"
|
|
"select username, 'SCHEMA', ' ' from all_users where username not like 'BIN$%'\n"
|
|
"union\n"
|
|
"select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n"
|
|
"where object_name not like 'BIN$%'\n"
|
|
"and object_type in ('VIEW', 'SEQUENCE', 'PACKAGE', 'TRIGGER', 'TABLE', 'SYNONYM', 'INDEX', 'FUNCTION', 'PROCEDURE');")
|
|
'sqlplus-my-handler))))
|
|
(when input-buffer
|
|
(save-selected-window
|
|
(when (equal (selected-window) (sqlplus-get-side-window))
|
|
(select-window (sqlplus-get-workbench-window)))
|
|
(switch-to-buffer input-buffer)))
|
|
(let ((saved-window (cons (selected-window) (window-buffer (selected-window))))
|
|
(input-buffer (get-buffer (sqlplus-get-input-buffer-name connect-string))))
|
|
(when (or (eq output-buffer-flag 'show-output-buffer) (null output-buffer-flag))
|
|
(sqlplus-show-buffer connect-string))
|
|
(if (window-live-p (car saved-window))
|
|
(select-window (car saved-window))
|
|
(if (get-buffer-window (cdr saved-window))
|
|
(select-window (get-buffer-window (cdr saved-window)))
|
|
(when (and input-buffer
|
|
(get-buffer-window input-buffer))
|
|
(select-window (get-buffer-window input-buffer))))))
|
|
;; executing initial sequence (between /* init */ and /* end */)
|
|
(when (and (not was-process) input-buffer)
|
|
(with-current-buffer input-buffer
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(when (re-search-forward (concat "^" sqlplus-init-sequence-start-regexp "\\s-*\n\\(\\(.\\|\n\\)*?\\)\n" sqlplus-init-sequence-end-regexp) nil t)
|
|
(when (match-string 1)
|
|
(sqlplus-send-region nil (match-beginning 1) (match-end 1) t))))))))
|
|
|
|
;; Command under cursor selection mechanism
|
|
(when window-system
|
|
(run-with-idle-timer 0 t (lambda () (when (eq major-mode 'sqlplus-mode) (sqlplus-highlight-current-sqlplus-command))))
|
|
(run-with-idle-timer 1 t (lambda ()
|
|
(when (eq major-mode 'sqlplus-mode)
|
|
(if (>= (sqlplus-color-percentage (face-background 'default)) 50)
|
|
(set-face-attribute 'sqlplus-command-highlight-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) (- sqlplus-command-highlighting-percentage)))
|
|
(set-face-attribute 'sqlplus-command-highlight-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) sqlplus-command-highlighting-percentage)))))))
|
|
|
|
(defun sqlplus-output-buffer-hide-show ()
|
|
(if (and (consp buffer-invisibility-spec)
|
|
(assq 'hide-symbol buffer-invisibility-spec))
|
|
(remove-from-invisibility-spec '(hide-symbol . t))
|
|
(add-to-invisibility-spec '(hide-symbol . t)))
|
|
(let ((overlay (car (overlays-at (point)))))
|
|
(when overlay
|
|
(goto-char (overlay-start overlay))
|
|
(beginning-of-line)))
|
|
(recenter 0))
|
|
|
|
(defun sqlplus-font-lock-value-in-major-mode (alist mode-symbol)
|
|
(if (consp alist)
|
|
(cdr (or (assq mode-symbol alist) (assq t alist)))
|
|
alist))
|
|
|
|
(defun sqlplus-get-history-buffer (connect-string)
|
|
(let* ((history-buffer-name (sqlplus-get-history-buffer-name connect-string))
|
|
(history-buffer (get-buffer history-buffer-name)))
|
|
(unless history-buffer
|
|
(setq history-buffer (get-buffer-create history-buffer-name))
|
|
(with-current-buffer history-buffer
|
|
(setq sqlplus-cs connect-string)
|
|
(add-hook 'kill-buffer-hook 'sqlplus-history-buffer-kill-function nil t)))
|
|
history-buffer))
|
|
|
|
(defun sqlplus-history-buffer-kill-function ()
|
|
(when sqlplus-history-dir
|
|
(condition-case err
|
|
(progn
|
|
(unless (file-directory-p sqlplus-history-dir)
|
|
(make-directory sqlplus-history-dir t))
|
|
(append-to-file 1 (buffer-size) (concat (file-name-as-directory sqlplus-history-dir) (car (refine-connect-string sqlplus-cs t)) "-hist.txt")))
|
|
(error (message (error-message-string err))))))
|
|
|
|
(defun sqlplus-soft-shutdown (connect-string)
|
|
(unless (some (lambda (buffer)
|
|
(with-current-buffer buffer
|
|
(and sqlplus-connect-string
|
|
(equal (car (refine-connect-string sqlplus-connect-string))
|
|
(car (refine-connect-string connect-string))))))
|
|
(buffer-list))
|
|
(sqlplus-shutdown connect-string)))
|
|
|
|
(defun sqlplus-shutdown (connect-string &optional dont-kill-input-buffer)
|
|
"Kill input, output and process buffer for specified CONNECT-STRING."
|
|
(let ((input-buffers (delq nil (mapcar (lambda (buffer) (with-current-buffer buffer
|
|
(when (and (eq major-mode 'sqlplus-mode)
|
|
(equal (car (refine-connect-string sqlplus-connect-string))
|
|
(car (refine-connect-string connect-string))))
|
|
buffer))) (buffer-list))))
|
|
(output-buffer (get-buffer (sqlplus-get-output-buffer-name connect-string)))
|
|
(history-buffer (get-buffer (sqlplus-get-history-buffer-name connect-string)))
|
|
(process-buffer (get-buffer (sqlplus-get-process-buffer-name connect-string))))
|
|
(when history-buffer
|
|
(kill-buffer history-buffer))
|
|
(when (and process-buffer
|
|
(with-current-buffer process-buffer sqlplus-process-p))
|
|
(when (get-process (sqlplus-get-process-name connect-string))
|
|
(delete-process (sqlplus-get-process-name connect-string)))
|
|
(kill-buffer process-buffer))
|
|
(when (and output-buffer
|
|
(with-current-buffer output-buffer sqlplus-connect-string))
|
|
(when (buffer-file-name output-buffer)
|
|
(with-current-buffer output-buffer
|
|
(save-buffer)))
|
|
(kill-buffer output-buffer))
|
|
(dolist (input-buffer input-buffers)
|
|
(when (buffer-file-name input-buffer)
|
|
(with-current-buffer input-buffer
|
|
(save-buffer)))
|
|
(unless dont-kill-input-buffer
|
|
(kill-buffer input-buffer)))))
|
|
|
|
(defun sqlplus-magic ()
|
|
(let (bottom-message pos)
|
|
(delete-region (point) (progn (beginning-of-line 3) (point)))
|
|
(setq bottom-message (buffer-substring (point) (save-excursion (end-of-line) (point))))
|
|
(setq pos (point))
|
|
(when (re-search-forward "^-------" nil t)
|
|
(delete-region pos (progn (beginning-of-line 2) (point)))
|
|
(while (re-search-forward "|" (save-excursion (end-of-line) (point)) t)
|
|
(save-excursion
|
|
(backward-char)
|
|
(if (or (bolp) (save-excursion (forward-char) (eolp)))
|
|
(while (member (char-after) '(?- ?|))
|
|
(delete-char 1)
|
|
(sqlplus-next-line))
|
|
(while (member (char-after) '(?- ?|))
|
|
(delete-char 1)
|
|
(insert " ")
|
|
(backward-char)
|
|
(sqlplus-next-line)))))
|
|
(beginning-of-line 3)
|
|
(re-search-forward "^---" nil t)
|
|
(goto-char (match-beginning 0))
|
|
(delete-region (point) (point-max))
|
|
(insert (format "%s\n\n%s\n" sqlplus-repfooter bottom-message))
|
|
)))
|
|
|
|
|
|
(defun sqlplus-process-command-output (context connect-string begin end interrupted)
|
|
(let* ((output-buffer-name (sqlplus-get-output-buffer-name connect-string))
|
|
(output-buffer (get-buffer output-buffer-name))
|
|
(process-buffer (sqlplus-get-process-buffer-name connect-string))
|
|
str
|
|
error-list show-errors-p
|
|
slips-count
|
|
(user-function (sqlplus-get-context-value context :user-function))
|
|
(result-function (sqlplus-get-context-value context :result-table-function))
|
|
(last-compiled-file-path (sqlplus-get-context-value context :last-compiled-file-path))
|
|
(compilation-expected (sqlplus-get-context-value context :compilation-expected))
|
|
(columns-count (sqlplus-get-context-value context :columns-count))
|
|
(sql (sqlplus-get-context-value context :sql))
|
|
(original-buffer (current-buffer))
|
|
explain-plan
|
|
table-data)
|
|
(setq slips-count columns-count)
|
|
(with-temp-buffer
|
|
(insert-buffer-substring original-buffer begin end)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward (concat "\n+" (regexp-quote sqlplus-page-separator) "\n") nil t)
|
|
(replace-match "\n"))
|
|
(goto-char (point-min))
|
|
(setq str (buffer-string))
|
|
(while (string-match (concat "^" (regexp-quote sqlplus-repfooter) "\n") str)
|
|
(setq str (replace-match "" nil t str)))
|
|
|
|
;; compilation errors?
|
|
(goto-char (point-min))
|
|
(skip-chars-forward "\n\t ")
|
|
(when (and ;;(not (equal (point) (point-max)))
|
|
plsql-auto-parse-errors-flag
|
|
output-buffer
|
|
last-compiled-file-path
|
|
(re-search-forward "^\\(LINE/COL\\|\\(SP2\\|CPY\\|ORA\\)-[0-9]\\{4,5\\}:\\|No errors\\|Nie ma b..d.w\\|Keine Fehler\\|No hay errores\\|Identificateur erron\\|Nessun errore\\|N..o h.. erros\\)" nil t))
|
|
(goto-char (point-min))
|
|
(setq error-list (plsql-parse-errors last-compiled-file-path)
|
|
show-errors-p compilation-expected))
|
|
|
|
;; explain?
|
|
(let ((case-fold-search t))
|
|
(goto-char (point-min))
|
|
(skip-chars-forward "\n\t ")
|
|
(when (and sql
|
|
(string-match "^[\n\t ]*explain\\>" sql)
|
|
(looking-at "Explained[.]"))
|
|
(delete-region (point-min) (point-max))
|
|
(setq str "")
|
|
(sqlplus--send connect-string
|
|
"select plan_table_output from table(dbms_xplan.display(null, null, 'TYPICAL'));"
|
|
nil
|
|
'no-echo
|
|
nil)))
|
|
|
|
;; plan table output?
|
|
(goto-char (point-min))
|
|
(skip-chars-forward "\n\t ")
|
|
(when (and (looking-at "^PLAN_TABLE_OUTPUT\n")
|
|
sqlplus-format-output-tables-flag
|
|
(not compilation-expected)
|
|
(not show-errors-p))
|
|
(sqlplus-magic) ;; TODO
|
|
(goto-char (point-min))
|
|
(re-search-forward "^[^\n]+" nil t)
|
|
(delete-region (point-min) (progn (beginning-of-line) (point)))
|
|
;; (setq slips-count 1)
|
|
(setq explain-plan t)
|
|
(setq table-data (save-excursion (sqlplus-parse-output-table interrupted))))
|
|
|
|
;; query result?
|
|
(goto-char (point-min))
|
|
(when (and sqlplus-format-output-tables-flag
|
|
(not compilation-expected)
|
|
(not table-data)
|
|
(not show-errors-p)
|
|
(not (re-search-forward "^LINE/COL\\>" nil t)))
|
|
(setq table-data (save-excursion (sqlplus-parse-output-table interrupted))))
|
|
(if user-function
|
|
(funcall user-function connect-string context (or table-data str))
|
|
(when output-buffer
|
|
(with-current-buffer output-buffer
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(cond (show-errors-p
|
|
(insert str)
|
|
(plsql-display-errors (file-name-directory last-compiled-file-path) error-list)
|
|
(let* ((plsql-buf (get-file-buffer last-compiled-file-path))
|
|
(win (when plsql-buf (car (get-buffer-window-list plsql-buf)))))
|
|
(when win
|
|
(select-window win))))
|
|
((and table-data
|
|
(car table-data))
|
|
(if result-function
|
|
(funcall result-function connect-string table-data)
|
|
(let ((b (point))
|
|
(warning-regexp (regexp-opt sqlplus-explain-plan-warning-regexps))
|
|
e)
|
|
(sqlplus-draw-table table-data slips-count)
|
|
(when interrupted (insert ". . .\n"))
|
|
(setq e (point))
|
|
(when explain-plan
|
|
(save-excursion
|
|
(goto-char b)
|
|
(while (re-search-forward warning-regexp nil t)
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'face (list (cons 'foreground-color "red") (list :weight 'bold)
|
|
(get-text-property (match-beginning 0) 'face))))))))))
|
|
(t
|
|
(insert str))))))))))
|
|
|
|
(defun sqlplus-result-online (connect-string context string last-chunk)
|
|
(let ((output-buffer (sqlplus-get-output-buffer-name connect-string)))
|
|
(when output-buffer
|
|
(with-current-buffer output-buffer
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(insert string))))))
|
|
|
|
(defvar sqlplus-prompt-regexp (concat "^" (regexp-quote sqlplus-prompt-prefix) "\\([0-9]+\\)" (regexp-quote sqlplus-prompt-suffix)))
|
|
|
|
(defvar sqlplus-page-separator-regexp (concat "^" (regexp-quote sqlplus-page-separator)))
|
|
|
|
(defun sqlplus-process-filter (process string)
|
|
(with-current-buffer (process-buffer process)
|
|
(let* ((prompt-safe-len (+ (max (+ (length sqlplus-prompt-prefix) (length sqlplus-prompt-suffix)) (length sqlplus-page-separator)) 10))
|
|
current-context-id filter-input-processed
|
|
(connect-string sqlplus-process-p)
|
|
(chunk-begin-pos (make-marker))
|
|
(chunk-end-pos (make-marker))
|
|
(prompt-found (make-marker))
|
|
(context (sqlplus-get-context connect-string current-context-id))
|
|
(current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name))
|
|
(current-command-input-buffer-names (when current-command-input-buffer-name (list current-command-input-buffer-name))))
|
|
(set-marker chunk-begin-pos (max 1 (- (point) prompt-safe-len)))
|
|
(goto-char (point-max))
|
|
(insert string)
|
|
(unless current-command-input-buffer-names
|
|
(setq current-command-input-buffer-names
|
|
(delq nil (mapcar (lambda (buffer) (with-current-buffer buffer
|
|
(when (and (memq major-mode '(sqlplus-mode plsql-mode))
|
|
sqlplus-connect-string
|
|
(equal (car (refine-connect-string sqlplus-connect-string))
|
|
(car (refine-connect-string connect-string))))
|
|
buffer))) (buffer-list)))))
|
|
;; fan animation
|
|
(dolist (current-command-input-buffer-name current-command-input-buffer-names)
|
|
(let ((input-buffer (get-buffer current-command-input-buffer-name)))
|
|
(when input-buffer
|
|
(with-current-buffer input-buffer
|
|
(setq sqlplus-fan
|
|
(cond ((equal sqlplus-fan "|") "/")
|
|
((equal sqlplus-fan "/") "-")
|
|
((equal sqlplus-fan "-") "\\")
|
|
((equal sqlplus-fan "\\") "|")))
|
|
(put-text-property 0 (length sqlplus-fan) 'face '((foreground-color . "red")) sqlplus-fan)
|
|
(put-text-property 0 (length sqlplus-fan) 'help-echo (sqlplus-get-context-value context :sql) sqlplus-fan)
|
|
(force-mode-line-update)))))
|
|
(unwind-protect
|
|
(while (not filter-input-processed)
|
|
(let* ((context (sqlplus-get-context connect-string current-context-id))
|
|
(dont-parse-result (sqlplus-get-context-value context :dont-parse-result))
|
|
(current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name))
|
|
(result-function (sqlplus-get-context-value context :result-function))
|
|
(skip-to-the-end-of-command (sqlplus-get-context-value context :skip-to-the-end-of-command)))
|
|
(set-marker prompt-found nil)
|
|
(goto-char chunk-begin-pos)
|
|
(set-marker chunk-end-pos
|
|
(if (or (re-search-forward sqlplus-prompt-regexp nil t)
|
|
(re-search-forward "^SQL> " nil t))
|
|
(progn
|
|
(set-marker prompt-found (match-end 0))
|
|
(when (match-string 1)
|
|
(setq current-context-id (string-to-number (match-string 1))))
|
|
(match-beginning 0))
|
|
(point-max)))
|
|
(cond ((and (equal chunk-begin-pos chunk-end-pos) ; at the end of command
|
|
(marker-position prompt-found))
|
|
;; deactivate fan
|
|
(dolist (current-command-input-buffer-name current-command-input-buffer-names)
|
|
(let ((input-buffer (get-buffer current-command-input-buffer-name)))
|
|
(when input-buffer
|
|
(with-current-buffer input-buffer
|
|
(remove-text-properties 0 (length sqlplus-fan) '(face nil) sqlplus-fan)
|
|
(force-mode-line-update)))))
|
|
(delete-region 1 prompt-found)
|
|
(when dont-parse-result
|
|
(funcall (or result-function 'sqlplus-result-online) connect-string context "" t))
|
|
(sqlplus-set-context-value context :skip-to-the-end-of-command nil)
|
|
(set-marker chunk-begin-pos 1))
|
|
((equal chunk-begin-pos chunk-end-pos)
|
|
(when dont-parse-result
|
|
(delete-region 1 (point-max)))
|
|
(setq filter-input-processed t))
|
|
(dont-parse-result
|
|
(funcall (or result-function 'sqlplus-result-online)
|
|
connect-string
|
|
context
|
|
(buffer-substring chunk-begin-pos chunk-end-pos)
|
|
(marker-position prompt-found))
|
|
(set-marker chunk-begin-pos chunk-end-pos))
|
|
(t
|
|
(when (not skip-to-the-end-of-command)
|
|
(goto-char (max 1 (- chunk-begin-pos 4010)))
|
|
(let ((page-separator-found
|
|
(save-excursion (let ((pos (re-search-forward (concat sqlplus-page-separator-regexp "[^-]*\\(^-\\|^<th\\b\\)") nil t)))
|
|
(when (and pos
|
|
(or (not (marker-position prompt-found))
|
|
(< pos prompt-found)))
|
|
(match-beginning 0))))))
|
|
(when (or (marker-position prompt-found) page-separator-found)
|
|
(goto-char (or page-separator-found chunk-end-pos))
|
|
(let ((end-pos (point))
|
|
(cur-msg (or (current-message) "")))
|
|
(sqlplus-set-context-value context :skip-to-the-end-of-command page-separator-found)
|
|
(when page-separator-found
|
|
(interrupt-process)
|
|
(save-excursion
|
|
(re-search-backward "[^ \t\n]\n" nil t)
|
|
(setq end-pos (match-end 0))))
|
|
(if result-function
|
|
(save-excursion (funcall result-function context connect-string 1 end-pos page-separator-found))
|
|
(with-temp-message "Formatting output..."
|
|
(save-excursion (sqlplus-process-command-output context connect-string 1 end-pos page-separator-found)))
|
|
(message "%s" cur-msg))
|
|
(when page-separator-found
|
|
(delete-region 1 (+ page-separator-found (length sqlplus-page-separator)))
|
|
(set-marker chunk-end-pos 1))))))
|
|
(set-marker chunk-begin-pos chunk-end-pos)))))
|
|
(goto-char (point-max))
|
|
(set-marker chunk-begin-pos nil)
|
|
(set-marker chunk-end-pos nil)
|
|
(set-marker prompt-found nil)))))
|
|
|
|
(defadvice switch-to-buffer (around switch-to-buffer-around-advice (buffer-or-name &optional norecord))
|
|
ad-do-it
|
|
(when (and sqlplus-connect-string
|
|
(eq major-mode 'sqlplus-mode))
|
|
(let ((side-window (sqlplus-get-side-window))
|
|
(output-buffer (get-buffer (sqlplus-get-output-buffer-name sqlplus-connect-string))))
|
|
(when (and side-window
|
|
(not (eq (window-buffer) output-buffer)))
|
|
(save-selected-window
|
|
(switch-to-buffer-other-window output-buffer))))))
|
|
(ad-activate 'switch-to-buffer)
|
|
|
|
(defun sqlplus-kill-function ()
|
|
(unless sqlplus-kill-function-inhibitor
|
|
;; shutdown connection if it is SQL*Plus output buffer or SQL*Plus process buffer
|
|
(if (or (and sqlplus-connect-string (equal (buffer-name) (sqlplus-get-output-buffer-name sqlplus-connect-string)))
|
|
sqlplus-process-p)
|
|
(sqlplus--enqueue-task 'sqlplus-shutdown (or sqlplus-connect-string sqlplus-process-p))
|
|
;; input buffer or another buffer connected to SQL*Plus - possibly shutdown
|
|
(when sqlplus-connect-string
|
|
(let ((counter 0)
|
|
(scs sqlplus-connect-string))
|
|
(dolist (buffer (buffer-list))
|
|
(with-current-buffer buffer
|
|
(when (equal sqlplus-connect-string scs) (incf counter))))
|
|
(when (<= counter 2)
|
|
(let* ((process (get-process (sqlplus-get-process-name sqlplus-connect-string))))
|
|
(when (or (not process)
|
|
(memq (process-status process) '(exit signal))
|
|
(y-or-n-p (format "Kill SQL*Plus process %s " (car (refine-connect-string sqlplus-connect-string)))))
|
|
(sqlplus--enqueue-task 'sqlplus-shutdown sqlplus-connect-string)))))))))
|
|
|
|
(defun sqlplus-emacs-kill-function ()
|
|
;; save and kill all sqlplus-mode buffers
|
|
(let (buffers-to-kill)
|
|
(dolist (buffer (buffer-list))
|
|
(with-current-buffer buffer
|
|
(when (and sqlplus-connect-string
|
|
(eq major-mode 'sqlplus-mode))
|
|
(when (buffer-file-name)
|
|
(save-buffer))
|
|
(push buffer buffers-to-kill))))
|
|
(setq sqlplus-kill-function-inhibitor t)
|
|
(condition-case nil
|
|
(unwind-protect
|
|
(dolist (buffer buffers-to-kill)
|
|
(kill-buffer buffer))
|
|
(setq sqlplus-kill-function-inhibitor nil))
|
|
(error nil))
|
|
t))
|
|
|
|
(push 'sqlplus-emacs-kill-function kill-emacs-query-functions)
|
|
|
|
(add-hook 'kill-buffer-hook 'sqlplus-kill-function)
|
|
|
|
;; kill all history buffers so that they can save themselves
|
|
(add-hook 'kill-emacs-hook (lambda ()
|
|
(dolist (buf (copy-list (buffer-list)))
|
|
(when (and (string-match "@.*-hist" (buffer-name buf))
|
|
(with-current-buffer buf sqlplus-cs))
|
|
(kill-buffer buf)))))
|
|
|
|
(defun sqlplus-find-output-table (interrupted)
|
|
"Search for table in last SQL*Plus command result, and return
|
|
list (BEGIN END MSG) for first and last table char, or nil if
|
|
table is not found."
|
|
(let (begin end)
|
|
(goto-char (point-min))
|
|
(when (re-search-forward "^[^\n]+\n\\( \\)?-" nil t)
|
|
(let (msg
|
|
(indent (when (match-string 1) -1))) ; result of 'describe' sqlplus command
|
|
(forward-line -1)
|
|
;; (untabify (point) (buffer-size))
|
|
(setq begin (point))
|
|
(when indent
|
|
(indent-rigidly begin (point-max) indent)
|
|
(goto-char begin))
|
|
(if indent
|
|
(progn
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n\t ")
|
|
(setq end (point))
|
|
(goto-char (point-max)))
|
|
(or (re-search-forward (concat "^" (regexp-quote sqlplus-repfooter) "\n[\n\t ]*") nil t)
|
|
(when interrupted (re-search-forward "\\'" nil t))) ; \\' means end of buffer
|
|
(setq end (match-beginning 0))
|
|
(setq msg (buffer-substring (match-end 0) (point-max))))
|
|
(list begin end msg)))))
|
|
|
|
(defstruct col-desc
|
|
id ; from 0
|
|
name ; column name
|
|
start-pos ; char column number
|
|
end-pos ; char column number
|
|
max-width ; max. column width
|
|
preferred-width ; preferred column width
|
|
min-prefix-len ; min. prefix (spaces only)
|
|
numeric ; y if column is numeric, n if is not, nil if don't know
|
|
has-eol ; temporary value for processing current row
|
|
)
|
|
|
|
(defun sqlplus-previous-line ()
|
|
(let ((col (current-column)))
|
|
(forward-line -1)
|
|
(move-to-column col t)))
|
|
|
|
(defun sqlplus-next-line ()
|
|
(let ((col (current-column)))
|
|
(forward-line 1)
|
|
(move-to-column col t)))
|
|
|
|
(defun sqlplus--correct-column-name (max-col-no)
|
|
(let ((counter 0)
|
|
(big (1- (save-excursion (beginning-of-line) (point)))))
|
|
(skip-chars-forward " ")
|
|
(when (re-search-forward " [^ \n]" (+ big max-col-no) t)
|
|
(backward-char)
|
|
(while (< (point) (+ big max-col-no))
|
|
(setq counter (1+ counter))
|
|
(insert " ")))
|
|
counter))
|
|
|
|
(defun sqlplus-parse-output-table (interrupted)
|
|
"Parse table and return list (COLUMN-INFOS ROWS MSG) where
|
|
COLUMN-INFOS is a col-desc structures list, ROWS is a table of
|
|
records (record is a list of strings). Return nil if table is
|
|
not detected."
|
|
(let ((region (sqlplus-find-output-table interrupted)))
|
|
(when region
|
|
(let ((begin (car region))
|
|
(end (cadr region))
|
|
(last-msg (caddr region))
|
|
(col-counter 0)
|
|
column-infos rows
|
|
(record-lines 1)
|
|
finish)
|
|
;; (message "'%s'\n'%s'" (buffer-substring begin end) last-msg)
|
|
(goto-char begin)
|
|
;; we are at the first char of column name
|
|
;; move to the first char of '-----' column separator
|
|
(beginning-of-line 2)
|
|
(while (not finish)
|
|
(if (equal (char-after) ?-)
|
|
;; at the first column separator char
|
|
(let* ((beg (point))
|
|
(col-begin (current-column))
|
|
(col-max-width (skip-chars-forward "-"))
|
|
;; after last column separator char
|
|
(ed (point))
|
|
(col-end (+ col-begin col-max-width))
|
|
(col-name (let* ((b (progn
|
|
(goto-char beg)
|
|
(sqlplus-previous-line)
|
|
(save-excursion
|
|
(let ((counter (sqlplus--correct-column-name (1+ col-end))))
|
|
(setq beg (+ beg counter))
|
|
(setq ed (+ ed counter))))
|
|
(point)))
|
|
(e (+ b col-max-width)))
|
|
(skip-chars-forward " \t")
|
|
(setq b (point))
|
|
(goto-char (min (save-excursion (end-of-line) (point)) e))
|
|
(skip-chars-backward " \t")
|
|
(setq e (point))
|
|
(if (> e b)
|
|
(buffer-substring b e)
|
|
"")))
|
|
(col-preferred-width (string-width col-name)))
|
|
;; (put-text-property 0 (length col-name) 'face '(bold) col-name)
|
|
(push (make-col-desc :id col-counter :name col-name :start-pos col-begin
|
|
:end-pos col-end :max-width col-max-width :preferred-width col-preferred-width :min-prefix-len col-max-width)
|
|
column-infos)
|
|
(incf col-counter)
|
|
(goto-char ed)
|
|
(if (equal (char-after) ?\n)
|
|
(progn
|
|
(beginning-of-line 3)
|
|
(incf record-lines))
|
|
(forward-char)))
|
|
(setq finish t)))
|
|
(decf record-lines)
|
|
(setq column-infos (nreverse column-infos))
|
|
(forward-line -1)
|
|
|
|
;; at the first char of first data cell.
|
|
;; table parsing...
|
|
(while (< (point) end)
|
|
(let (record last-start-pos)
|
|
(dolist (column-info column-infos)
|
|
(let ((start-pos (col-desc-start-pos column-info))
|
|
(end-pos (col-desc-end-pos column-info))
|
|
width len value b e l)
|
|
(when (and last-start-pos
|
|
(<= start-pos last-start-pos))
|
|
(forward-line))
|
|
(setq last-start-pos start-pos)
|
|
(move-to-column start-pos)
|
|
(setq b (point))
|
|
(move-to-column end-pos)
|
|
(setq e (point))
|
|
(move-to-column start-pos)
|
|
(setq l (skip-chars-forward " " e))
|
|
(when (and (col-desc-min-prefix-len column-info)
|
|
(< l (- e b))
|
|
(< l (col-desc-min-prefix-len column-info)))
|
|
(setf (col-desc-min-prefix-len column-info)
|
|
(if (looking-at "[0-9]") l nil)))
|
|
(move-to-column end-pos)
|
|
(skip-chars-backward " " b)
|
|
(setq value (if (> (point) b) (buffer-substring b (point)) ""))
|
|
(setq len (length value)
|
|
width (string-width value))
|
|
(when (and sqlplus-select-result-max-col-width
|
|
(> len sqlplus-select-result-max-col-width))
|
|
(setq value (concat (substring value 0 sqlplus-select-result-max-col-width) "...")
|
|
len (length value)
|
|
width (string-width value)))
|
|
(when (> width (col-desc-preferred-width column-info))
|
|
(setf (col-desc-preferred-width column-info) width))
|
|
(when (and (< l (- e b))
|
|
(memq (col-desc-numeric column-info) '(nil y)))
|
|
(setf (col-desc-numeric column-info)
|
|
(if (string-match "\\` *[-+0-9Ee.,$]+\\'" value) 'y 'n)))
|
|
(push value record)))
|
|
(forward-line)
|
|
(when (> record-lines 1)
|
|
(forward-line))
|
|
(setq last-start-pos nil
|
|
record (nreverse record))
|
|
(push record rows)))
|
|
(setq rows (nreverse rows))
|
|
(list column-infos rows last-msg)))))
|
|
|
|
(defun sqlplus-draw-table (lst &optional slips-count)
|
|
"SLIPS-COUNT (nil means compute automatically)."
|
|
;; current buffer: SQL*Plus output buffer
|
|
(when window-system
|
|
(if (>= (sqlplus-color-percentage (face-background 'default)) 50)
|
|
(progn
|
|
(set-face-attribute 'sqlplus-table-head-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) -70) :foreground (face-background 'default))
|
|
(set-face-attribute 'sqlplus-table-even-rows-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) -20) :overline (face-background 'default))
|
|
(set-face-attribute 'sqlplus-table-odd-rows-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) -30) :overline (face-background 'default)))
|
|
(set-face-attribute 'sqlplus-table-head-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) +70) :foreground (face-background 'default))
|
|
(set-face-attribute 'sqlplus-table-even-rows-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) +20) :overline (face-background 'default))
|
|
(set-face-attribute 'sqlplus-table-odd-rows-face nil
|
|
:background (sqlplus-shine-color (face-background 'default) +30) :overline (face-background 'default))))
|
|
(let* ((column-infos (car lst))
|
|
(rows (cadr lst))
|
|
(slip-width 0)
|
|
(table-header-height 1)
|
|
(table-area-width (1- (let ((side-window (sqlplus-get-side-window))) (if side-window (window-width side-window) (frame-width)))))
|
|
;; may be nil, which means no limit
|
|
(table-area-height (let ((side-window (sqlplus-get-side-window)))
|
|
(when side-window
|
|
(- (window-height side-window) 2 (if mode-line-format 1 0) (if header-line-format 1 0)))))
|
|
(column-separator-width (if sqlplus-elegant-style 1.2 (max (length sqlplus-table-col-separator) (length sqlplus-table-col-head-separator))))
|
|
rows-per-slip ;; data rows per slip
|
|
(slip-separator-width (if sqlplus-elegant-style 1.5 sqlplus-slip-separator-width))
|
|
(slip-separator (make-string (max 0 (if sqlplus-elegant-style 1 sqlplus-slip-separator-width)) ?\ ))
|
|
(last-msg (caddr lst)))
|
|
(when sqlplus-elegant-style
|
|
(put-text-property 0 1 'display (cons 'space (list :width slip-separator-width)) slip-separator))
|
|
(when (<= table-area-height table-header-height)
|
|
(setq table-area-height nil))
|
|
(when (and window-system sqlplus-elegant-style table-area-height (> table-area-height 3))
|
|
;; overline makes glyph higher...
|
|
(setq table-area-height (- table-area-height (round (/ (* 20.0 (- table-area-height 3)) (face-attribute 'default :height))))))
|
|
(when column-infos
|
|
(goto-char (point-max))
|
|
(beginning-of-line)
|
|
;; slip width (without separator between slips)
|
|
(dolist (col-info column-infos)
|
|
(when (col-desc-min-prefix-len col-info)
|
|
(setf (col-desc-preferred-width col-info) (max (string-width (col-desc-name col-info))
|
|
(- (col-desc-preferred-width col-info) (col-desc-min-prefix-len col-info)))))
|
|
(incf slip-width (+ (col-desc-preferred-width col-info) column-separator-width)))
|
|
(when (> slip-width 0)
|
|
(setq slip-width (+ (- slip-width column-separator-width) (if sqlplus-elegant-style 1.0 0))))
|
|
;; computing slip count if not known yet
|
|
(unless slips-count
|
|
(setq slips-count
|
|
(if table-area-height (min (ceiling (/ (float (length rows)) (max 1 (- table-area-height table-header-height 2))))
|
|
(max 1 (floor (/ (float table-area-width) (+ slip-width slip-separator-width)))))
|
|
1)))
|
|
(setq slips-count (max 1 (min slips-count (length rows)))) ; slip count <= data rows
|
|
(setq rows-per-slip (ceiling (/ (float (length rows)) slips-count)))
|
|
(when (> rows-per-slip 0)
|
|
(setq slips-count (max 1 (min (ceiling (/ (float (length rows)) rows-per-slip)) slips-count))))
|
|
|
|
(let ((table-begin-point (point)))
|
|
(dotimes (slip-no slips-count)
|
|
(let ((row-no 0)
|
|
(slip-begin-point (point))
|
|
(rows-processed 0))
|
|
;; column names
|
|
(dolist (col-info column-infos)
|
|
(let* ((col-name (col-desc-name col-info))
|
|
(spaces (max 0 (- (col-desc-preferred-width col-info) (string-width col-name))))
|
|
(last-col-p (>= (1+ (col-desc-id col-info)) (length column-infos)))
|
|
(val (format (if sqlplus-elegant-style " %s%s %s" "%s%s%s")
|
|
col-name
|
|
(make-string spaces ?\ )
|
|
(if last-col-p "" (if sqlplus-elegant-style " " sqlplus-table-col-separator)))))
|
|
(put-text-property 0 (if (or (not sqlplus-elegant-style) last-col-p) (length val) (1- (length val)))
|
|
'face 'sqlplus-table-head-face val)
|
|
(when sqlplus-elegant-style
|
|
(put-text-property 0 1 'display '(space . (:width 0.5)) val)
|
|
(put-text-property (- (length val) (if last-col-p 1 2)) (- (length val) (if last-col-p 0 1)) 'display '(space . (:width 0.5)) val)
|
|
(unless last-col-p
|
|
(put-text-property (- (length val) 1) (length val) 'display '(space . (:width 0.2)) val)))
|
|
(insert val)))
|
|
(insert slip-separator)
|
|
(insert "\n")
|
|
;; data rows
|
|
(while (and (< rows-processed rows-per-slip)
|
|
rows)
|
|
(let ((row (car rows)))
|
|
(setq rows (cdr rows))
|
|
(incf rows-processed)
|
|
(let ((col-infos column-infos))
|
|
(dolist (value row)
|
|
(let* ((col-info (car col-infos))
|
|
(numeric-p (eq (col-desc-numeric col-info) 'y))
|
|
(min-prefix (col-desc-min-prefix-len col-info)))
|
|
(when (and min-prefix
|
|
value
|
|
(>= (length value) min-prefix))
|
|
(setq value (substring value min-prefix)))
|
|
(let* ((spaces (max 0 (- (col-desc-preferred-width col-info) (string-width value))))
|
|
(val (if numeric-p
|
|
(format (if sqlplus-elegant-style " %s%s %s" "%s%s%s")
|
|
(make-string spaces ?\ )
|
|
value
|
|
(if (cdr col-infos) (if sqlplus-elegant-style " " sqlplus-table-col-separator) ""))
|
|
(format (if sqlplus-elegant-style " %s%s %s" "%s%s%s")
|
|
value
|
|
(make-string spaces ?\ )
|
|
(if (cdr col-infos) (if sqlplus-elegant-style " " sqlplus-table-col-separator) "")))))
|
|
(put-text-property 0 (if (and sqlplus-elegant-style (cdr col-infos)) (- (length val) 1) (length val))
|
|
'face (if (evenp row-no)
|
|
'sqlplus-table-even-rows-face
|
|
'sqlplus-table-odd-rows-face) val)
|
|
(when sqlplus-elegant-style
|
|
(put-text-property 0 1 'display '(space . (:width 0.5)) val)
|
|
(put-text-property (- (length val) (if (cdr col-infos) 2 1))
|
|
(- (length val) (if (cdr col-infos) 1 0))
|
|
'display '(space . (:width 0.5)) val)
|
|
(when (cdr col-infos)
|
|
(put-text-property (- (length val) 1) (length val) 'display '(space . (:width 0.2)) val)))
|
|
(setq col-infos (cdr col-infos))
|
|
(insert val))))
|
|
(incf row-no)
|
|
(insert slip-separator)
|
|
(insert "\n"))))
|
|
(when (> slip-no 0)
|
|
(delete-backward-char 1)
|
|
(let ((slip-end-point (point)))
|
|
(kill-rectangle slip-begin-point slip-end-point)
|
|
(delete-region slip-begin-point (point-max))
|
|
(goto-char table-begin-point)
|
|
(end-of-line)
|
|
(yank-rectangle)
|
|
(goto-char (point-max))
|
|
))))
|
|
(goto-char (point-max))
|
|
(when (and last-msg (> (length last-msg) 0))
|
|
(unless sqlplus-elegant-style (insert "\n"))
|
|
(let ((s (format "%s\n\n" (replace-regexp-in-string "\n+" " " last-msg))))
|
|
(when sqlplus-elegant-style
|
|
(put-text-property (- (length s) 2) (1- (length s)) 'display '(space . (:height 1.5)) s))
|
|
(insert s)))))))
|
|
|
|
(defun sqlplus-send-user-string (str)
|
|
(interactive (progn (sqlplus-check-connection)
|
|
(if sqlplus-connect-string
|
|
(list (read-string "Send to process: " nil 'sqlplus-user-string-history ""))
|
|
(error "Works only in SQL*Plus buffer"))))
|
|
(let ((connect-string sqlplus-connect-string))
|
|
(sqlplus-verify-buffer connect-string)
|
|
(let* ((process (get-process (sqlplus-get-process-name connect-string)))
|
|
(output-buffer-name (sqlplus-get-output-buffer-name connect-string)))
|
|
(sqlplus-echo-in-buffer output-buffer-name (concat str "\n"))
|
|
(send-string process (concat str "\n")))))
|
|
|
|
(defun sqlplus-prepare-update-alist (table-data)
|
|
(let ((column-infos (car table-data))
|
|
(rows (cadr table-data))
|
|
(msg (caddr table-data))
|
|
alist)
|
|
(dolist (row rows)
|
|
(let* ((object-name (car row))
|
|
(object-type (intern (downcase (cadr row))))
|
|
(status (caddr row))
|
|
(regexp-list (cdr (assq object-type alist)))
|
|
(pair (cons object-name (equal status "I"))))
|
|
(if regexp-list
|
|
(setcdr regexp-list (cons pair (cdr regexp-list)))
|
|
(setq regexp-list (list pair))
|
|
(setq alist (cons (cons object-type regexp-list) alist)))))
|
|
alist))
|
|
|
|
(defun sqlplus-my-update-handler (connect-string table-data)
|
|
(let ((alist (sqlplus-prepare-update-alist table-data)))
|
|
(when (featurep 'ide-skel)
|
|
(funcall 'sqlplus-side-view-update-data connect-string alist))))
|
|
|
|
(defun sqlplus-my-handler (connect-string table-data)
|
|
(let ((alist (sqlplus-prepare-update-alist table-data))
|
|
(sqlplus-font-lock-regexps (sqlplus-get-font-lock-regexps connect-string)))
|
|
(sqlplus-set-objects-alist alist connect-string)
|
|
(when (featurep 'ide-skel)
|
|
(funcall 'sqlplus-side-view-update-data connect-string alist))
|
|
(clrhash sqlplus-font-lock-regexps)
|
|
(dolist (lst sqlplus-syntax-faces)
|
|
(let* ((object-type (car lst))
|
|
(regexp-list (append (caddr lst) (mapcar 'car (cdr (assq object-type alist))))))
|
|
(when regexp-list
|
|
(puthash object-type (concat "\\b" (regexp-opt regexp-list t) "\\b") sqlplus-font-lock-regexps))))
|
|
(let ((map sqlplus-font-lock-regexps))
|
|
(mapc (lambda (buffer)
|
|
(with-current-buffer buffer
|
|
(when (and (memq major-mode '(sqlplus-mode plsql-mode))
|
|
(equal sqlplus-connect-string connect-string))
|
|
(when font-lock-mode (font-lock-mode 1)))))
|
|
(buffer-list)))))
|
|
|
|
(defun sqlplus-get-source-function (connect-string context string last-chunk)
|
|
(let* ((source-text (sqlplus-get-context-value context :source-text))
|
|
(source-type (sqlplus-get-context-value context :source-type))
|
|
(source-name (sqlplus-get-context-value context :source-name))
|
|
(source-extension (sqlplus-get-context-value context :source-extension))
|
|
(name (concat (upcase source-name) "." source-extension))
|
|
finish)
|
|
(unless (sqlplus-get-context-value context :finished)
|
|
(setq source-text (concat source-text string))
|
|
(sqlplus-set-context-value context :source-text source-text)
|
|
(when last-chunk
|
|
(if (string-match (regexp-quote sqlplus-end-of-source-sentinel) source-text)
|
|
(when (< (length source-text) (+ (length sqlplus-end-of-source-sentinel) 5))
|
|
(setq last-chunk nil
|
|
finish "There is no such database object"))
|
|
(setq last-chunk nil)))
|
|
(when last-chunk
|
|
(setq finish t))
|
|
(when finish
|
|
(sqlplus-set-context-value context :finished t)
|
|
(if (stringp finish)
|
|
(message finish)
|
|
(with-temp-buffer
|
|
(insert source-text)
|
|
(goto-char (point-min))
|
|
(re-search-forward (regexp-quote sqlplus-end-of-source-sentinel) nil t)
|
|
(replace-match "")
|
|
(goto-char (point-max))
|
|
(forward-comment (- (buffer-size)))
|
|
(when (equal source-type "TABLE")
|
|
(goto-char (point-min))
|
|
(insert (format "table %s\n(\n" source-name))
|
|
(goto-char (point-max))
|
|
(delete-region (re-search-backward "," nil t) (point-max))
|
|
(insert "\n);"))
|
|
(insert "\n/\n")
|
|
(unless (member source-type '("SEQUENCE" "TABLE" "SYNONYM" "INDEX"))
|
|
(insert "show err\n"))
|
|
(goto-char (point-min))
|
|
(insert "create " (if (member source-type '("INDEX" "SEQUENCE" "TABLE")) "" "or replace "))
|
|
(setq source-text (buffer-string)))
|
|
(with-current-buffer (get-buffer-create name)
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(insert source-text)
|
|
(goto-char (point-min))
|
|
(set-visited-file-name (concat (file-name-as-directory temporary-file-directory)
|
|
(concat (make-temp-name (sqlplus-canonize-file-name (concat (upcase source-name) "_") "[$]")) "." source-extension)))
|
|
(rename-buffer name)
|
|
(condition-case err
|
|
(funcall (symbol-function 'plsql-mode))
|
|
(error nil))
|
|
(setq sqlplus-connect-string connect-string
|
|
buffer-read-only sqlplus-source-buffer-readonly-by-default-flag)
|
|
(save-buffer)
|
|
(save-selected-window
|
|
(let ((win (selected-window)))
|
|
(when (or (equal win (sqlplus-get-side-window))
|
|
(and (fboundp 'ide-skel-side-view-window-p)
|
|
(funcall 'ide-skel-side-view-window-p win)))
|
|
(setq win (sqlplus-get-workbench-window)))
|
|
(set-window-buffer win (current-buffer))))))))))
|
|
|
|
(defun sqlplus-get-source (connect-string name type &optional schema-name)
|
|
"Fetch source for database object NAME in current or specified SCHEMA-NAME, and show the source in new buffer.
|
|
Possible TYPE values are in 'sqlplus-object-types'."
|
|
(interactive (let* ((thing (thing-at-point 'symbol))
|
|
(obj-raw-name (read-string (concat "Object name" (if thing (concat " [default " thing "]") "") ": ")
|
|
nil
|
|
'sqlplus-get-source-history (when thing thing)))
|
|
(completion-ignore-case t)
|
|
(type (completing-read "Object type: " (mapcar (lambda (type) (cons type nil)) sqlplus-object-types) nil t)))
|
|
(string-match "^\\(\\([^.]+\\)[.]\\)?\\(.*\\)$" obj-raw-name)
|
|
(list sqlplus-connect-string (match-string 3 obj-raw-name) type (match-string 2 obj-raw-name))))
|
|
(setq type (upcase type))
|
|
(let* ((sql
|
|
(cond ((equal type "SEQUENCE")
|
|
(format (concat "select 'sequence %s' || sequence_name || "
|
|
"decode( increment_by, 1, '', ' increment by ' || increment_by ) || "
|
|
"case when increment_by > 0 and max_value >= (1.0000E+27)-1 or increment_by < 0 and max_value = -1 then '' "
|
|
"else decode( max_value, null, ' nomaxvalue', ' maxvalue ' || max_value) end || "
|
|
"case when increment_by > 0 and min_value = 1 or increment_by < 0 and min_value <= (-1.0000E+26)+1 then '' "
|
|
"else decode( min_value, null, ' nominvalue', ' minvalue ' || min_value) end || "
|
|
"decode( cycle_flag, 'Y', ' cycle', '' ) || "
|
|
"decode( cache_size, 20, '', 0, ' nocache', ' cache ' || cache_size ) || "
|
|
"decode( order_flag, 'Y', ' order', '' ) "
|
|
"from %s where sequence_name = '%s'%s;")
|
|
(if schema-name (concat (upcase schema-name) ".") "")
|
|
(if schema-name "all_sequences" "user_sequences")
|
|
(upcase name)
|
|
(if schema-name (format " and sequence_owner = '%s'" (upcase schema-name)) "")))
|
|
((equal type "TABLE")
|
|
(format (concat "select ' ' || column_name || ' ' || data_type || "
|
|
"decode( data_type,"
|
|
" 'VARCHAR2', '(' || to_char( data_length, 'fm9999' ) || ')',"
|
|
" 'NUMBER', decode( data_precision,"
|
|
" null, '',"
|
|
" '(' || to_char( data_precision, 'fm9999' ) || decode( data_scale,"
|
|
" null, '',"
|
|
" 0, '',"
|
|
" ',' || data_scale ) || ')' ),"
|
|
" '') || "
|
|
"decode( nullable, 'Y', ' not null', '') || ','"
|
|
"from all_tab_columns "
|
|
"where owner = %s and table_name = '%s' "
|
|
"order by column_id;")
|
|
(if schema-name (concat "'" (upcase schema-name) "'") "user")
|
|
(upcase name)))
|
|
((equal type "SYNONYM")
|
|
(format (concat "select "
|
|
"decode( owner, 'PUBLIC', 'public ', '' ) || 'synonym ' || "
|
|
"decode( owner, 'PUBLIC', '', user, '', owner || '.' ) || synonym_name || ' for ' || "
|
|
"decode( table_owner, user, '', table_owner || '.' ) || table_name || "
|
|
"decode( db_link, null, '', '@' || db_link ) "
|
|
"from all_synonyms where (owner = 'PUBLIC' or owner = %s) and synonym_name = '%s';")
|
|
(if schema-name (concat "'" (upcase schema-name) "'") "user")
|
|
(upcase name)))
|
|
((equal type "VIEW")
|
|
(if schema-name (format "select 'view %s.' || view_name || ' as ', text from all_views where owner = '%s' and view_name = '%s';"
|
|
(upcase schema-name) (upcase schema-name) (upcase name))
|
|
(format "select 'view ' || view_name || ' as ', text from user_views where view_name = '%s';" (upcase name))))
|
|
((or (equal type "PROCEDURE")
|
|
(equal type "FUNCTION"))
|
|
(if schema-name (format "select text from all_source where owner = '%s' and name = '%s' and type in ('PROCEDURE', 'FUNCTION') order by line;"
|
|
(upcase schema-name) (upcase name))
|
|
(format "select text from user_source where name = '%s' and type in ('PROCEDURE', 'FUNCTION') order by line;"
|
|
(upcase name))))
|
|
(t
|
|
(if schema-name (format "select text from all_source where owner = '%s' and name = '%s' and type = '%s' order by line;"
|
|
(upcase schema-name) (upcase name) (upcase type))
|
|
(format "select text from user_source where name = '%s' and type = '%s' order by line;"
|
|
(upcase name) (upcase type))))))
|
|
(prolog-commands (list "set echo off"
|
|
"set newpage 0"
|
|
"set space 0"
|
|
"set pagesize 0"
|
|
"set feedback off"
|
|
"set long 4000"
|
|
"set longchunksize 4000"
|
|
"set wrap on"
|
|
"set heading off"
|
|
"set trimspool on"
|
|
"set linesize 4000"
|
|
"set timing off"))
|
|
(extension (if (equal (downcase type) "package") "pks" "sql"))
|
|
(source-buffer-name (concat " " (upcase name) "." extension))
|
|
(context-options (list (cons :dont-parse-result 'dont-parse)
|
|
(cons :source-text nil)
|
|
(cons :source-type type)
|
|
(cons :source-name name)
|
|
(cons :source-extension extension)
|
|
(cons :result-function 'sqlplus-get-source-function))))
|
|
(sqlplus-execute connect-string sql context-options prolog-commands t t)
|
|
(sqlplus-execute connect-string (format "select '%s' from dual;" sqlplus-end-of-source-sentinel) context-options prolog-commands t t)))
|
|
|
|
(defun sqlplus-canonize-file-name (file-name regexp)
|
|
(while (string-match regexp file-name)
|
|
(setq file-name (replace-match "!" nil t file-name)))
|
|
file-name)
|
|
|
|
(defun sqlplus-define-user-variables (string)
|
|
(when string
|
|
(let (variables-list
|
|
define-commands
|
|
(index 0))
|
|
(while (setq index (string-match "&+\\(\\(\\sw\\|\\s_\\)+\\)" string index))
|
|
(let ((var-name (match-string 1 string)))
|
|
(setq index (+ 2 index))
|
|
(unless (member var-name variables-list)
|
|
(push var-name variables-list))))
|
|
(dolist (var-name (reverse variables-list))
|
|
(let* ((default-value (gethash var-name sqlplus-user-variables nil))
|
|
(value (read-string (format (concat "Variable value for %s" (if default-value (format " [default: %s]" default-value) "") ": ") var-name)
|
|
nil 'sqlplus-user-variables-history default-value)))
|
|
(unless value
|
|
(error "There is no value for %s defined" var-name))
|
|
(setq define-commands (cons (format "define %s=%s" var-name value) define-commands))
|
|
(puthash var-name value sqlplus-user-variables)))
|
|
define-commands)))
|
|
|
|
(defun sqlplus-parse-region (start end)
|
|
(let ((sql (buffer-substring start end)))
|
|
(save-excursion
|
|
;; Strip whitespace from beginning and end, just to be neat.
|
|
(if (string-match "\\`[ \t\n]+" sql)
|
|
(setq sql (substring sql (match-end 0))))
|
|
(if (string-match "[ \t\n]+\\'" sql)
|
|
(setq sql (substring sql 0 (match-beginning 0))))
|
|
(setq sql (replace-regexp-in-string "^[ \t]*--.*[\n]?" "" sql))
|
|
(when (zerop (length sql))
|
|
(error "Nothing to send"))
|
|
;; Now the string should end with an sqlplus-terminator.
|
|
(if (not (string-match "\\(;\\|/\\|[.]\\)\\'" sql))
|
|
(setq sql (concat sql ";"))))
|
|
sql))
|
|
|
|
(defun sqlplus-show-html-fun (context connect-string begin end interrupted)
|
|
(let ((output-file (expand-file-name (substitute-in-file-name sqlplus-html-output-file-name)))
|
|
(sql (sqlplus-get-context-value context :htmlized-html-command))
|
|
(html (buffer-substring begin end))
|
|
(header-html (eval sqlplus-html-output-header)))
|
|
(let ((case-fold-search t))
|
|
(while (and (string-match "\\`[ \t\n]*\\(<br>\\|<p>\\)?" html) (match-string 0 html) (> (length (match-string 0 html)) 0))
|
|
(setq html (replace-match "" nil t html)))
|
|
(when (> (length html) 0)
|
|
(sqlplus-execute connect-string "" nil '("set markup html off") 'no-echo 'dont-show-output-buffer)
|
|
(find-file output-file)
|
|
(erase-buffer)
|
|
(insert (concat "<html>\n"
|
|
"<head>\n"
|
|
" <meta http-equiv=\"content-type\" content=\"text/html; charset=" sqlplus-html-output-encoding "\">\n"
|
|
(sqlplus-get-context-value context :head) "\n"
|
|
"</head>\n"
|
|
"<body " (sqlplus-get-context-value context :body) ">\n"
|
|
(if header-html header-html "")
|
|
(if sqlplus-html-output-sql sql "")
|
|
"<p>"
|
|
html "\n"
|
|
"</body>\n"
|
|
"</html>"))
|
|
(goto-char (point-min))
|
|
(save-buffer)))))
|
|
|
|
(defun sqlplus-refine-html (html remove-entities)
|
|
(string-match "\\`\"?\\(\\(.\\|\n\\)*?\\)\"?[ \t\n]*\\'" html)
|
|
(setq html (match-string 1 html))
|
|
(if remove-entities
|
|
(progn
|
|
(while (string-match """ html) (setq html (replace-match "\"" nil t html)))
|
|
(while (string-match "<" html) (setq html (replace-match "<" nil t html)))
|
|
(while (string-match ">" html) (setq html (replace-match ">" nil t html)))
|
|
(while (string-match "&" html) (setq html (replace-match "&" nil t html))))
|
|
(while (string-match "&" html) (setq html (replace-match "&" nil t html)))
|
|
(while (string-match ">" html) (setq html (replace-match ">" nil t html)))
|
|
(while (string-match "<" html) (setq html (replace-match "<" nil t html)))
|
|
(while (string-match "\"" html) (setq html (replace-match """ nil t html))))
|
|
(string-match "\\`\"?\\(\\(.\\|\n\\)*?\\)\"?[ \t\n]*\\'" html)
|
|
(setq html (match-string 1 html))
|
|
html)
|
|
|
|
(defun sqlplus-show-markup-fun (context connect-string begin end interrupted)
|
|
(goto-char begin)
|
|
(let ((head "")
|
|
(body "")
|
|
preformat)
|
|
(when (re-search-forward (concat "\\bHEAD\\b[ \t\n]*\\(\\(.\\|\n\\)*\\)[ \t\n]*"
|
|
"\\bBODY\\b[ \t\n]*\\(\\(.\\|\n\\)*\\)[ \t\n]*"
|
|
"\\bTABLE\\b\\(.\\|\n\\)*PREFORMAT[ \t\n]+\\(ON\\|OFF\\)\\b") nil t)
|
|
(setq head (match-string 1)
|
|
body (match-string 3)
|
|
preformat (string= (downcase (match-string 6)) "on"))
|
|
(setq head (sqlplus-refine-html head t)
|
|
body (sqlplus-refine-html body t))
|
|
(let ((context-options (list (cons :result-function 'sqlplus-show-html-fun)
|
|
(cons :current-command-input-buffer-name (sqlplus-get-context-value context :current-command-input-buffer-name))
|
|
(cons :html-command (sqlplus-get-context-value context :html-command))
|
|
(cons :htmlized-html-command (sqlplus-get-context-value context :htmlized-html-command))
|
|
(cons :head head)
|
|
(cons :body body)))
|
|
(prolog-commands (list "set wrap on"
|
|
(format "set linesize %S" (if preformat (1- (frame-width)) 4000))
|
|
"set pagesize 50000"
|
|
"btitle off"
|
|
"repfooter off"
|
|
"set markup html on")))
|
|
(sqlplus-execute connect-string (sqlplus-get-context-value context :html-command) context-options prolog-commands 'no-echo 'dont-show-output-buffer)))))
|
|
|
|
(defun sqlplus-htmlize (begin end)
|
|
(let (result)
|
|
(when (featurep 'htmlize)
|
|
(let* ((htmlize-output-type 'font)
|
|
(buffer (funcall (symbol-function 'htmlize-region) begin end)))
|
|
(with-current-buffer buffer
|
|
(goto-char 1)
|
|
(re-search-forward "<pre>[ \t\n]*\\(\\(.\\|\n\\)*?\\)[ \t\n]*</pre>" nil t)
|
|
(setq result (concat "<pre>" (match-string 1) "</pre>")))
|
|
(kill-buffer buffer)))
|
|
(unless result
|
|
(setq result (sqlplus-refine-html (buffer-substring begin end) nil)))
|
|
result))
|
|
|
|
(defun sqlplus--send (connect-string sql &optional arg no-echo html start end)
|
|
(if html
|
|
(let* ((context-options (list (cons :result-function 'sqlplus-show-markup-fun)
|
|
(cons :current-command-input-buffer-name (buffer-name))
|
|
(cons :html-command sql)
|
|
(cons :htmlized-html-command (if (and (eq sqlplus-html-output-sql 'elegant) (featurep 'htmlize))
|
|
(sqlplus-htmlize start end)
|
|
(sqlplus-refine-html sql nil))))))
|
|
(sqlplus-execute connect-string "show markup\n" context-options nil 'no-echo 'dont-show-output-buffer))
|
|
(let* ((no-parse (consp arg))
|
|
(context-options (list (cons :dont-parse-result (consp arg))
|
|
(cons :columns-count (if (integerp arg)
|
|
(if (zerop arg) nil arg)
|
|
(if sqlplus-multi-output-tables-default-flag nil 1)))
|
|
(cons :current-command-input-buffer-name (buffer-name))))
|
|
(prolog-commands (list (format "set wrap %s" (if no-parse "on" sqlplus-default-wrap))
|
|
(format "set linesize %s" (if (consp arg) (1- (frame-width)) 4000))
|
|
(format "set pagesize %S" (if no-parse 50000 sqlplus-pagesize))
|
|
(format "btitle %s"
|
|
(if no-parse "off" (concat "left '" sqlplus-page-separator "'")))
|
|
(format "repfooter %s"
|
|
(if no-parse "off" (concat "left '" sqlplus-repfooter "'"))))))
|
|
(sqlplus-execute connect-string sql context-options prolog-commands no-echo))))
|
|
|
|
(defun sqlplus-explain ()
|
|
(interactive)
|
|
(sqlplus-check-connection)
|
|
(when (buffer-file-name)
|
|
(condition-case err
|
|
(save-buffer)
|
|
(error (message (error-message-string err)))))
|
|
(let* ((region (sqlplus-mark-current)))
|
|
(setq sqlplus-region-beginning-pos (car region)
|
|
sqlplus-region-end-pos (cdr region))
|
|
(if (and sqlplus-region-beginning-pos sqlplus-region-end-pos)
|
|
(let ((sql (sqlplus-parse-region (car region) (cdr region)))
|
|
(case-fold-search t))
|
|
(if (string-match "^[\n\t ]*explain[\n\t ]+plan[\t\t ]+for\\>" sql)
|
|
(sqlplus--send sqlplus-connect-string sql nil nil nil)
|
|
(setq sql (concat (sqlplus-fontify-string sqlplus-connect-string "explain plan for ") sql))
|
|
(sqlplus--send sqlplus-connect-string sql nil nil nil)))
|
|
(error "Point doesn't indicate any command to execute"))))
|
|
|
|
(defun sqlplus-send-region (arg start end &optional no-echo html)
|
|
"Send a region to the SQL*Plus process."
|
|
(interactive "P\nr")
|
|
(sqlplus-check-connection)
|
|
(sqlplus--send sqlplus-connect-string (sqlplus-parse-region start end) arg no-echo html start end))
|
|
|
|
(defun sqlplus-user-command (connect-string sql result-proc)
|
|
(let* ((context-options (list (cons :user-function result-proc)
|
|
(cons :columns-count 1)))
|
|
(prolog-commands (list (format "set wrap %s" sqlplus-default-wrap)
|
|
"set linesize 4000"
|
|
"set timing off"
|
|
"set pagesize 50000"
|
|
"btitle off"
|
|
(format "repfooter %s" (concat "left '" sqlplus-repfooter "'")))))
|
|
(sqlplus-execute connect-string sql context-options prolog-commands 'no-echo 'dont-show-output-buffer)))
|
|
|
|
|
|
(defun sqlplus-hidden-select (connect-string sql result-proc)
|
|
(let* ((context-options (list (cons :result-table-function result-proc)
|
|
(cons :columns-count 1)))
|
|
(prolog-commands (list (format "set wrap %s" sqlplus-default-wrap)
|
|
"set linesize 4000"
|
|
"set pagesize 50000"
|
|
"btitle off"
|
|
(format "repfooter %s" (concat "left '" sqlplus-repfooter "'")))))
|
|
(sqlplus-execute connect-string sql context-options prolog-commands 'no-echo 'dont-show-output-buffer)))
|
|
|
|
;; "appi[nfo]" -> '("appinfo" "appi")
|
|
(defun sqlplus-full-forms (name)
|
|
(if (string-match "\\`\\([^[]*\\)?\\[\\([^]]+\\)\\]\\([^]]*\\)?\\'" name)
|
|
(list (replace-match "\\1\\2\\3" t nil name)
|
|
(replace-match "\\1\\3" t nil name))
|
|
(list name)))
|
|
|
|
(defun sqlplus-get-canonical-command-name (name)
|
|
(let ((association (assoc (downcase name) sqlplus-system-variables)))
|
|
(if association (cdr association) name)))
|
|
|
|
|
|
(defun sqlplus-execute (connect-string sql context-options prolog-commands &optional no-echo dont-show-output-buffer)
|
|
(sqlplus-verify-buffer connect-string)
|
|
(let* ((process-buffer-name (sqlplus-get-process-buffer-name connect-string))
|
|
(process-buffer (get-buffer process-buffer-name))
|
|
(output-buffer-name (sqlplus-get-output-buffer-name connect-string))
|
|
(echo-prolog (concat "\n" sqlplus-output-separator " " (current-time-string) "\n\n"))
|
|
(process (get-buffer-process process-buffer-name))
|
|
set-prolog-commands commands command-no
|
|
(history-buffer (sqlplus-get-history-buffer connect-string))
|
|
(defines (sqlplus-define-user-variables sql)))
|
|
(setq prolog-commands (append (sqlplus-initial-strings) prolog-commands))
|
|
(when process-buffer
|
|
(with-current-buffer process-buffer
|
|
(setq command-no sqlplus-command-seq)
|
|
(incf sqlplus-command-seq)
|
|
(setq context-options (append (list (cons :id command-no) (cons :sql sql)) (copy-list context-options)))
|
|
(setq sqlplus-command-contexts (reverse (cons context-options (reverse sqlplus-command-contexts))))))
|
|
;; move all "set" commands from prolog-commands to set-prolog-commands
|
|
(setq prolog-commands (delq nil (mapcar (lambda (command) (if (string-match "^\\s-*[sS][eE][tT]\\s-+" command)
|
|
(progn
|
|
(setq set-prolog-commands
|
|
(append set-prolog-commands
|
|
(list (substring command (length (match-string 0 command))))))
|
|
nil)
|
|
command))
|
|
prolog-commands)))
|
|
;; remove duplicates commands from prolog-commands (last entries win)
|
|
(let (spc-alist)
|
|
(dolist (command prolog-commands)
|
|
(let* ((name (progn (string-match "^\\S-+" command) (downcase (match-string 0 command))))
|
|
(association (assoc name spc-alist)))
|
|
(if (and association (not (equal name "define")))
|
|
(setcdr association command)
|
|
(setq spc-alist (cons (cons name command) spc-alist)))))
|
|
(setq prolog-commands (mapcar (lambda (pair) (cdr pair)) (reverse spc-alist))))
|
|
|
|
(setq prolog-commands (append prolog-commands defines))
|
|
(setq set-prolog-commands (append (list (format "sqlprompt '%s%S%s'" sqlplus-prompt-prefix command-no sqlplus-prompt-suffix)) set-prolog-commands))
|
|
|
|
;; remove duplicates from set-prolog-commands (last entries win)
|
|
(let (spc-alist)
|
|
(dolist (set-command set-prolog-commands)
|
|
(let* ((name (progn (string-match "^\\S-+" set-command) (downcase (sqlplus-get-canonical-command-name (match-string 0 set-command)))))
|
|
(association (assoc name spc-alist)))
|
|
(if association
|
|
(setcdr association set-command)
|
|
(setq spc-alist (cons (cons name set-command) spc-alist)))))
|
|
(setq set-prolog-commands (mapcar (lambda (pair) (cdr pair)) (reverse spc-alist))))
|
|
|
|
(setq commands (concat (mapconcat 'identity (append
|
|
(list (concat "set " (mapconcat 'identity set-prolog-commands " ")))
|
|
prolog-commands
|
|
(list sql)) "\n")
|
|
"\n"))
|
|
(when history-buffer
|
|
(with-current-buffer history-buffer
|
|
(goto-char (point-max))
|
|
(insert echo-prolog)
|
|
(insert (concat commands "\n"))))
|
|
(let ((saved-window (cons (selected-window) (window-buffer (selected-window))))
|
|
(input-buffer (get-buffer (sqlplus-get-input-buffer-name connect-string))))
|
|
(unless no-echo
|
|
(sqlplus-echo-in-buffer output-buffer-name echo-prolog)
|
|
(let ((old-suppress-show-output-buffer sqlplus-suppress-show-output-buffer))
|
|
(unwind-protect
|
|
(save-selected-window
|
|
(setq sqlplus-suppress-show-output-buffer dont-show-output-buffer)
|
|
(when (and output-buffer-name
|
|
(get-buffer output-buffer-name))
|
|
(with-current-buffer (get-buffer output-buffer-name)
|
|
(sqlplus-buffer-bottom connect-string)
|
|
(sqlplus-buffer-mark-current connect-string))))
|
|
(setq sqlplus-suppress-show-output-buffer old-suppress-show-output-buffer)))
|
|
(sqlplus-echo-in-buffer output-buffer-name (concat sql "\n\n") nil t)
|
|
(save-selected-window
|
|
(unless dont-show-output-buffer
|
|
(when (and output-buffer-name
|
|
(get-buffer output-buffer-name))
|
|
(with-current-buffer (get-buffer output-buffer-name)
|
|
(sqlplus-buffer-redisplay-current connect-string))))))
|
|
(if (window-live-p (car saved-window))
|
|
(select-window (car saved-window))
|
|
(if (get-buffer-window (cdr saved-window))
|
|
(select-window (get-buffer-window (cdr saved-window)))
|
|
(when (and input-buffer
|
|
(get-buffer-window input-buffer))
|
|
(select-window (get-buffer-window input-buffer))))))
|
|
(send-string process commands)))
|
|
|
|
(defun sqlplus-fontify-string (connect-string string)
|
|
(let* ((input-buffer-name (sqlplus-get-input-buffer-name connect-string))
|
|
(input-buffer (when input-buffer-name (get-buffer input-buffer-name)))
|
|
(result string))
|
|
(when (and input-buffer (buffer-live-p input-buffer))
|
|
(with-current-buffer input-buffer
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(let ((pos (point)))
|
|
(insert "\n\n")
|
|
(insert string)
|
|
(font-lock-fontify-block (+ (count "\n" string) 2))
|
|
(setq result (buffer-substring (+ pos 2) (point-max)))
|
|
(delete-region pos (point-max))))))
|
|
result))
|
|
|
|
(defvar plsql-mark-backward-list nil)
|
|
|
|
(unless plsql-mode-map
|
|
(setq plsql-mode-map (copy-keymap sql-mode-map))
|
|
(define-key plsql-mode-map "\M-." 'sqlplus-file-get-source)
|
|
(define-key plsql-mode-map [C-down-mouse-1] 'sqlplus-mouse-select-identifier)
|
|
(define-key plsql-mode-map [C-mouse-1] 'sqlplus-file-get-source-mouse)
|
|
(define-key plsql-mode-map "\C-c\C-g" 'plsql-begin)
|
|
(define-key plsql-mode-map "\C-c\C-q" 'plsql-loop)
|
|
(define-key plsql-mode-map "\C-c\C-z" 'plsql-if)
|
|
(define-key plsql-mode-map "\C-c\C-c" 'plsql-compile)
|
|
(define-key plsql-mode-map [tool-bar plsql-prev-mark]
|
|
(list 'menu-item "Previous mark" 'plsql-prev-mark
|
|
:image plsql-prev-mark-image
|
|
:enable 'plsql-mark-backward-list)))
|
|
|
|
(defvar plsql-continue-anyway nil
|
|
"Local in input buffer (plsql-mode).")
|
|
(make-variable-buffer-local 'plsql-continue-anyway)
|
|
|
|
(defun sqlplus-switch-to-buffer (buffer-or-path &optional line-no)
|
|
(if (fboundp 'ide-skel-select-buffer)
|
|
(funcall 'ide-skel-select-buffer buffer-or-path line-no)
|
|
(let ((buffer (or (and (bufferp buffer-or-path) buffer-or-path)
|
|
(find-file-noselect buffer-or-path))))
|
|
(switch-to-buffer buffer)
|
|
(goto-line line-no))))
|
|
|
|
(defun plsql-prev-mark ()
|
|
(interactive)
|
|
(let (finish)
|
|
(while (and plsql-mark-backward-list
|
|
(not finish))
|
|
(let* ((marker (pop plsql-mark-backward-list))
|
|
(buffer (marker-buffer marker))
|
|
(point (marker-position marker)))
|
|
(set-marker marker nil)
|
|
(when (and buffer
|
|
(or (not (eq (current-buffer) buffer))
|
|
(not (eql (point) point))))
|
|
(sqlplus-switch-to-buffer buffer)
|
|
(goto-char point)
|
|
(setq finish t))))
|
|
;; (message "BACK: %S -- FORWARD: %S" plsql-mark-backward-list plsql-mark-forward-list)
|
|
(force-mode-line-update)
|
|
(sit-for 0)))
|
|
|
|
(defun sqlplus-mouse-select-identifier (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(save-excursion
|
|
(let* ((point (posn-point (event-start event)))
|
|
(identifier (progn (goto-char point) (thing-at-point 'symbol)))
|
|
(ident-regexp (when identifier (regexp-quote identifier))))
|
|
(push (point-marker) plsql-mark-backward-list)
|
|
(when ident-regexp
|
|
(save-excursion
|
|
(while (not (looking-at ident-regexp))
|
|
(backward-char))
|
|
(sqlplus-mouse-set-selection (current-buffer) (point) (+ (point) (length identifier)) 'highlight)))))))
|
|
|
|
(defun sqlplus-file-get-source-mouse (event)
|
|
(interactive "@e")
|
|
(let (ident)
|
|
(with-selected-window (posn-window (event-start event))
|
|
(save-excursion
|
|
(goto-char (posn-point (event-start event)))
|
|
(setq ident (thing-at-point 'symbol))))
|
|
(sqlplus-file-get-source sqlplus-connect-string ident nil)
|
|
(sit-for 0)))
|
|
|
|
(defun plsql-compile (&optional arg)
|
|
"Save buffer and send its content to SQL*Plus.
|
|
You must enter connect-string if buffer is disconnected; with
|
|
argument you can change connect-string even for connected
|
|
buffer."
|
|
(interactive "P")
|
|
(let (aborted
|
|
exists-show-error-command
|
|
(case-fold-search t))
|
|
(save-window-excursion
|
|
(save-excursion
|
|
;; ask for "/" and "show err" if absent
|
|
(let ((old-point (point))
|
|
show-err-needed
|
|
exists-run-command best-point finish)
|
|
(goto-char (point-min))
|
|
(setq show-err-needed (let ((case-fold-search t))
|
|
(re-search-forward "create\\([ \t\n]+or[ \t\n]+replace\\)?[ \t\n]+\\(package\\|procedure\\|function\\|trigger\\|view\\|type\\)" nil t)))
|
|
(goto-char (point-max))
|
|
(forward-comment (- (buffer-size)))
|
|
(re-search-backward "^\\s-*show\\s-+err" nil t)
|
|
(forward-comment (- (buffer-size)))
|
|
(condition-case nil (forward-char) (error nil))
|
|
(setq best-point (point))
|
|
(goto-char (point-min))
|
|
(setq exists-run-command (re-search-forward "^\\s-*/[^*]" nil t))
|
|
(goto-char (point-min))
|
|
(setq exists-show-error-command (or (not show-err-needed) (re-search-forward "^\\s-*show\\s-+err" nil t)))
|
|
(while (and (not plsql-continue-anyway) (or (not exists-run-command) (not exists-show-error-command)) (not finish))
|
|
(goto-char best-point)
|
|
(let ((c (read-char
|
|
(format "Cannot find %s. (I)nsert it at point, (A)bort, (C)ontinue anyway"
|
|
(concat (unless exists-run-command "\"/\"")
|
|
(unless (or exists-run-command exists-show-error-command) " and ")
|
|
(unless exists-show-error-command "\"show err\""))))))
|
|
(cond ((memq c '(?i ?I))
|
|
(unless exists-run-command (insert "/\n"))
|
|
(unless exists-show-error-command (insert "show err\n"))
|
|
(setq finish t))
|
|
((memq c '(?a ?A))
|
|
(setq aborted t
|
|
finish t))
|
|
((memq c '(?c ?C))
|
|
(setq plsql-continue-anyway t)
|
|
(setq finish t))))))))
|
|
(unless aborted
|
|
(save-buffer)
|
|
(let* ((buffer (current-buffer))
|
|
(input-buffer-name (buffer-name))
|
|
(file-path (sqlplus-file-truename (buffer-file-name)))
|
|
(compilation-buffer (get-buffer sqlplus-plsql-compilation-results-buffer-name))
|
|
(context-options (list (cons :last-compiled-file-path file-path)
|
|
(cons :current-command-input-buffer-name input-buffer-name)
|
|
(cons :compilation-expected exists-show-error-command)))
|
|
(prolog-commands (list (format "set wrap %s" sqlplus-default-wrap)
|
|
"set linesize 4000"
|
|
(format "set pagesize %S" sqlplus-pagesize)
|
|
(format "btitle %s" (concat "left '" sqlplus-page-separator "'"))
|
|
(format "repfooter %s" (concat "left '" sqlplus-repfooter "'")))))
|
|
(when (or (not sqlplus-connect-string)
|
|
arg)
|
|
(setq sqlplus-connect-string (car (sqlplus-read-connect-string nil (caar (sqlplus-divide-connect-strings))))))
|
|
(sqlplus sqlplus-connect-string nil (when plsql-auto-parse-errors-flag 'dont-show-output-buffer))
|
|
(set-buffer buffer)
|
|
(force-mode-line-update)
|
|
(when font-lock-mode (font-lock-mode 1))
|
|
(when compilation-buffer
|
|
(with-current-buffer compilation-buffer
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer))))
|
|
(setq prolog-commands (append prolog-commands (sqlplus-define-user-variables (buffer-string))))
|
|
(sqlplus-execute sqlplus-connect-string (concat "@" file-path) context-options prolog-commands nil exists-show-error-command)))))
|
|
|
|
(defun plsql-parse-errors (last-compiled-file-path)
|
|
(let ((file-name (file-name-nondirectory last-compiled-file-path))
|
|
error-list)
|
|
(put-text-property 0 (length file-name) 'face 'font-lock-warning-face file-name)
|
|
(save-excursion
|
|
(when (re-search-forward "^LINE/COL\\>" nil t)
|
|
(beginning-of-line 3)
|
|
(while (re-search-forward "^\\([0-9]+\\)/\\([0-9]+\\)\\s-*\\(\\(.\\|\n\\)*?\\)[\r\t ]*\n\\([\r\t ]*\\(\n\\|\\'\\)\\|[0-9]+\\)" nil t)
|
|
(let ((line-no (match-string 1))
|
|
(column-no (match-string 2))
|
|
(errmsg (match-string 3))
|
|
label)
|
|
(goto-char (match-beginning 5))
|
|
(while (string-match "\\s-\\s-+" errmsg)
|
|
(setq errmsg (replace-match " " nil t errmsg)))
|
|
(put-text-property 0 (length line-no) 'face 'font-lock-variable-name-face line-no)
|
|
(put-text-property 0 (length column-no) 'face 'font-lock-variable-name-face column-no)
|
|
(setq label (concat file-name ":" line-no ":" column-no ": " errmsg))
|
|
(put-text-property 0 (length label) 'mouse-face 'highlight label)
|
|
(push label error-list)))))
|
|
(save-excursion
|
|
(while (re-search-forward "\\s-\\([0-9]+\\):\n\\(ORA-[0-9]+[^\n]*\\)\n" nil t)
|
|
(let ((line-no (match-string 1))
|
|
(errmsg (match-string 2))
|
|
label)
|
|
(put-text-property 0 (length line-no) 'face 'font-lock-variable-name-face line-no)
|
|
(setq label (concat file-name ":" line-no ": " errmsg))
|
|
(put-text-property 0 (length label) 'mouse-face 'highlight label)
|
|
(push label error-list))))
|
|
(save-excursion
|
|
(while (re-search-forward "\\(\\(SP2\\|CPY\\)-[0-9]+:[^\n]*\\)\n" nil t)
|
|
(let ((errmsg (match-string 1))
|
|
label)
|
|
(setq label (concat file-name ":" errmsg))
|
|
(put-text-property 0 (length label) 'mouse-face 'highlight label)
|
|
(push label error-list))))
|
|
error-list))
|
|
|
|
(defun plsql-display-errors (dir error-list)
|
|
(let ((buffer (get-buffer-create sqlplus-plsql-compilation-results-buffer-name)))
|
|
(save-selected-window
|
|
(save-excursion
|
|
(set-buffer buffer)
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(setq default-directory dir)
|
|
(insert (format "cd %s\n" default-directory))
|
|
(insert (format "Compilation results\n"))
|
|
(compilation-minor-mode 1)
|
|
(dolist (msg (reverse error-list))
|
|
(insert msg)
|
|
(insert "\n"))
|
|
(insert (format "\n(%s errors)\n" (length error-list))))
|
|
(when (and error-list (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t)))
|
|
(switch-to-buffer-other-window buffer)
|
|
(goto-line 1)
|
|
(goto-line 3)))))
|
|
|
|
|
|
(defun sqlplus-file-truename (file-name)
|
|
(if file-name
|
|
(file-truename file-name)
|
|
file-name))
|
|
|
|
(defun sqlplus--hidden-buffer-name-p (buffer-name)
|
|
(equal (elt buffer-name 0) 32))
|
|
|
|
(defun sqlplus-get-workbench-window ()
|
|
"Return upper left window"
|
|
(if (fboundp 'ide-get-workbench-window)
|
|
(funcall (symbol-function 'ide-get-workbench-window))
|
|
(let (best-window)
|
|
(dolist (win (copy-list (window-list nil 1)))
|
|
(when (not (sqlplus--hidden-buffer-name-p (buffer-name (window-buffer win))))
|
|
(if (null best-window)
|
|
(setq best-window win)
|
|
(let* ((best-window-coords (window-edges best-window))
|
|
(win-coords (window-edges win)))
|
|
(when (or (< (cadr win-coords) (cadr best-window-coords))
|
|
(and (= (cadr win-coords) (cadr best-window-coords))
|
|
(< (car win-coords) (car best-window-coords))))
|
|
(setq best-window win))))))
|
|
;; (message "BEST-WINDOW: %S" best-window)
|
|
best-window)))
|
|
|
|
(defun sqlplus-get-side-window ()
|
|
"Return bottom helper window, or nil if not found"
|
|
(if (fboundp 'ide-get-side-window)
|
|
(funcall (symbol-function 'ide-get-side-window))
|
|
(let* ((workbench-window (sqlplus-get-workbench-window))
|
|
best-window)
|
|
(dolist (win (copy-list (window-list nil 1)))
|
|
(when (and (not (sqlplus--hidden-buffer-name-p (buffer-name (window-buffer win))))
|
|
(not (eq win workbench-window)))
|
|
(if (null best-window)
|
|
(setq best-window win)
|
|
(when (> (cadr (window-edges win)) (cadr (window-edges best-window)))
|
|
(setq best-window win)))))
|
|
best-window)))
|
|
|
|
(defvar sqlplus--idle-tasks nil)
|
|
|
|
(defun sqlplus--enqueue-task (fun &rest params)
|
|
(setq sqlplus--idle-tasks (reverse (cons (cons fun params) (reverse sqlplus--idle-tasks)))))
|
|
|
|
(defun sqlplus--execute-tasks ()
|
|
(dolist (task sqlplus--idle-tasks)
|
|
(let ((fun (car task))
|
|
(params (cdr task)))
|
|
(condition-case var
|
|
(apply fun params)
|
|
(error (message (error-message-string var))))))
|
|
(setq sqlplus--idle-tasks nil))
|
|
|
|
(add-hook 'post-command-hook 'sqlplus--execute-tasks)
|
|
|
|
(defvar sqlplus-mouse-selection nil)
|
|
|
|
(defun sqlplus-mouse-set-selection (buffer begin end mouse-face)
|
|
(interactive "@e")
|
|
(let ((old-buffer-modified-p (buffer-modified-p)))
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(unwind-protect
|
|
(put-text-property begin end 'mouse-face mouse-face)
|
|
(set-buffer-modified-p old-buffer-modified-p)
|
|
(setq sqlplus-mouse-selection (when mouse-face (list buffer begin end))))))))
|
|
|
|
(defun sqlplus-clear-mouse-selection ()
|
|
(when (and sqlplus-mouse-selection
|
|
(eq (event-basic-type last-input-event) 'mouse-1)
|
|
(not (memq 'down (event-modifiers last-input-event))))
|
|
(sqlplus-mouse-set-selection (car sqlplus-mouse-selection) (cadr sqlplus-mouse-selection) (caddr sqlplus-mouse-selection) nil)))
|
|
|
|
(add-hook 'plsql-mode-hook
|
|
(lambda ()
|
|
(modify-syntax-entry ?. "." sql-mode-syntax-table)
|
|
(setq sqlplus-font-lock-keywords-1 (sqlplus-set-font-lock-emacs-structures-for-level 1 major-mode))
|
|
(setq sqlplus-font-lock-keywords-2 (sqlplus-set-font-lock-emacs-structures-for-level 2 major-mode))
|
|
(setq sqlplus-font-lock-keywords-3 (sqlplus-set-font-lock-emacs-structures-for-level 3 major-mode))
|
|
(setq font-lock-defaults '((sqlplus-font-lock-keywords-1 sqlplus-font-lock-keywords-2 sqlplus-font-lock-keywords-3)
|
|
nil t ((?_ . "w") (?$ . "w") (?# . "w") (?& . "w"))))
|
|
(orcl-mode 1)
|
|
(use-local-map plsql-mode-map) ; std
|
|
(add-hook 'post-command-hook 'sqlplus-clear-mouse-selection nil t)))
|
|
|
|
(setq recentf-exclude (cons (concat "^" (regexp-quote (file-name-as-directory temporary-file-directory)))
|
|
(when (boundp 'recentf-exclude)
|
|
recentf-exclude)))
|
|
|
|
(when (fboundp 'ide-register-persistent-var)
|
|
(funcall (symbol-function 'ide-register-persistent-var) 'sqlplus-connect-strings-alist
|
|
;; save proc
|
|
(lambda (alist)
|
|
(mapcar (lambda (pair)
|
|
(if sqlplus-save-passwords
|
|
pair
|
|
(cons (car pair) nil)))
|
|
alist))
|
|
;; load proc
|
|
(lambda (alist)
|
|
(setq sqlplus-connect-string-history (mapcar (lambda (pair) (car pair)) alist))
|
|
alist)))
|
|
|
|
(defun get-all-dirs (root-dir)
|
|
(let ((list-to-see (list root-dir))
|
|
result-list)
|
|
(while list-to-see
|
|
(let* ((dir (pop list-to-see))
|
|
(children (directory-files dir t)))
|
|
(push dir result-list)
|
|
(dolist (child children)
|
|
(when (and (not (string-match "^[.]+"(file-name-nondirectory child)))
|
|
(file-directory-p child))
|
|
(push child list-to-see)))))
|
|
result-list))
|
|
|
|
(defun sqlplus-command-line ()
|
|
(interactive)
|
|
(if (comint-check-proc "*SQL*")
|
|
(pop-to-buffer "*SQL*")
|
|
(let* ((pair (sqlplus-read-connect-string nil (when sqlplus-connect-string (car (refine-connect-string sqlplus-connect-string)))))
|
|
(qualified-cs (car pair))
|
|
(refined-cs (cadr pair))
|
|
(password (cdr (refine-connect-string qualified-cs))))
|
|
(if (string-match "^\\([^@]*\\)@\\(.*\\)$" refined-cs)
|
|
(let ((old-sql-get-login-fun (symbol-function 'sql-get-login)))
|
|
(setq sql-user (match-string 1 refined-cs)
|
|
sql-password password
|
|
sql-database (match-string 2 refined-cs))
|
|
(unwind-protect
|
|
(progn
|
|
(fset 'sql-get-login (lambda (&rest whatever) nil))
|
|
(sql-oracle))
|
|
(fset 'sql-get-login old-sql-get-login-fun)))
|
|
(error "Connect string must be in form login@sid")))))
|
|
|
|
(defun sqlplus-find-tnsnames ()
|
|
(interactive)
|
|
(let* ((ora-home-dir (or (getenv "ORACLE_HOME") (error "Environment variable ORACLE_HOME not set")))
|
|
found
|
|
(list-to-see (list ora-home-dir)))
|
|
(while (and (not found) list-to-see)
|
|
(let* ((dir (pop list-to-see))
|
|
(children (condition-case nil (directory-files dir t) (error nil))))
|
|
(dolist (child children)
|
|
(unless found
|
|
(if (string-match "admin.tnsnames\.ora$" child)
|
|
(progn
|
|
(setq found t)
|
|
(find-file child))
|
|
(if (and (not (string-match "^[.]+" (file-name-nondirectory child)))
|
|
(file-directory-p child))
|
|
(push child list-to-see)))))))
|
|
(unless found
|
|
(message "File tnsnames.ora not found"))))
|
|
|
|
(defun sqlplus-remove-help-echo (list)
|
|
"Remove all HELP-ECHO properties from mode-line format value"
|
|
(when (listp list)
|
|
(if (eq (car list) :propertize)
|
|
(while list
|
|
(when (eq (cadr list) 'help-echo)
|
|
(setcdr list (cdddr list)))
|
|
(setq list (cdr list)))
|
|
(dolist (elem list) (sqlplus-remove-help-echo elem)))))
|
|
|
|
(when (>= emacs-major-version 22)
|
|
(sqlplus-remove-help-echo mode-line-modes))
|
|
|
|
(defun sqlplus-get-project-root-dir (path)
|
|
(let ((path (file-truename (substitute-in-file-name path)))
|
|
dir)
|
|
(if (file-directory-p path)
|
|
(progn
|
|
(setq path (file-name-as-directory path))
|
|
(setq dir path))
|
|
(setq dir (file-name-as-directory (file-name-directory path))))
|
|
(let ((last-project-dir dir)
|
|
(dir-list (split-string dir "/"))
|
|
is-project)
|
|
(while (directory-files dir t (concat "^" "\\(\\.svn\\|CVS\\)$") t)
|
|
(setq is-project t
|
|
last-project-dir (file-name-as-directory dir)
|
|
dir (file-name-as-directory (file-name-directory (directory-file-name dir)))))
|
|
(when is-project
|
|
(let ((list (nthcdr (1- (length (split-string last-project-dir "/"))) dir-list)))
|
|
(cond ((equal (car list) "trunk")
|
|
(setq last-project-dir (concat last-project-dir "trunk/")))
|
|
((member (car list) '("branches" "tags"))
|
|
(setq last-project-dir (concat last-project-dir (car list) "/" (when (cdr list) (concat (cadr list) "/")))))
|
|
(t)))
|
|
(setq dir last-project-dir)))
|
|
dir))
|
|
|
|
(defvar sqlplus-search-buffer-name "*search*")
|
|
|
|
(defvar sqlplus-object-types-regexps
|
|
'(
|
|
("TABLE" . "\\bcreate\\s+table\\s+[^(]*?\\b#\\b")
|
|
("VIEW" . "\\bview\\s+.*?\\b#\\b")
|
|
("INDEX" . "\\b(constraint|index)\\s+.*?\\b#\\b")
|
|
("TRIGGER" . "\\btrigger\\s+.*?\\b#\\b")
|
|
("SEQUENCE" . "\\bsequence\\s+.*?\\b#\\b")
|
|
("SYNONYM" . "\\bsynonym\\s+.*?\\b#\\b")
|
|
("SCHEMA" . "\\bcreate\\b.*?\\buser\\b.*?\\b#\\b")
|
|
("PROCEDURE" . "\\b(procedure|function)\\b[^(]*?\\b#\\b")
|
|
("PACKAGE" . "\\bpackage\\s+.*?\\b#\\b")))
|
|
|
|
(defvar sqlplus-root-dir-history nil)
|
|
|
|
(defvar sqlplus-compare-report-buffer-name "*Comparation Report*")
|
|
|
|
(defun sqlplus-compare-schema-to-filesystem (&optional arg)
|
|
(interactive "P")
|
|
(let* ((connect-string sqlplus-connect-string)
|
|
(objects-alist (sqlplus-get-objects-alist sqlplus-connect-string))
|
|
(report-buffer (get-buffer-create sqlplus-compare-report-buffer-name))
|
|
(types-length (- (length objects-alist) 2))
|
|
(root-dir (or (sqlplus-get-root-dir connect-string)
|
|
(sqlplus-set-project-for-connect-string connect-string)
|
|
(error "Root dir not set")))
|
|
(counter 0))
|
|
(unless objects-alist
|
|
(error "Not ready yet - try again later"))
|
|
(save-excursion
|
|
(switch-to-buffer-other-window report-buffer))
|
|
(with-current-buffer report-buffer
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert (format "%s %s vs. %s\n\n" (current-time-string) (car (refine-connect-string connect-string)) root-dir))
|
|
(sit-for 0)))
|
|
(dolist (pair objects-alist)
|
|
(let ((type (upcase (format "%s" (car pair))))
|
|
(names (cdr pair)))
|
|
(unless (member type '("SCHEMA" "COLUMN"))
|
|
(incf counter)
|
|
(message (format "%s (%d/%d)..." type counter types-length))
|
|
(dolist (name-pair names)
|
|
(let* ((name (car name-pair))
|
|
(grep-result (sqlplus-file-get-source sqlplus-connect-string name type 'batch-mode)))
|
|
(with-current-buffer report-buffer
|
|
(let ((inhibit-read-only t))
|
|
(goto-char (point-max))
|
|
(cond ((eql (length grep-result) 0)
|
|
(insert (format "%s %s: not found\n" type name))
|
|
(sit-for 0))
|
|
((and arg
|
|
(> (length grep-result) 1))
|
|
(insert (format "%s %s:\n" type name))
|
|
(dolist (list grep-result)
|
|
(insert (format " %s:%d %s\n" (car list) (cadr list) (caddr list))))
|
|
(sit-for 0))
|
|
(t)))))))))
|
|
(message "Done.")
|
|
(with-current-buffer report-buffer
|
|
(goto-char (point-min)))))
|
|
|
|
(defun sqlplus-proj-find-files (dir file-predicate &optional dir-predicate)
|
|
(setq dir (file-name-as-directory (file-truename (substitute-in-file-name dir))))
|
|
(let (result-list)
|
|
(mapcar (lambda (path)
|
|
(if (file-directory-p path)
|
|
(when (and (file-accessible-directory-p path)
|
|
(or (null dir-predicate)
|
|
(funcall dir-predicate path)))
|
|
(setq result-list (append result-list (sqlplus-proj-find-files path file-predicate dir-predicate))))
|
|
(when (or (null file-predicate)
|
|
(funcall file-predicate path))
|
|
(push path result-list))))
|
|
(delete (concat (file-name-as-directory dir) ".")
|
|
(delete (concat (file-name-as-directory dir) "..")
|
|
(directory-files dir t nil t))))
|
|
result-list))
|
|
|
|
(defvar sqlplus-proj-ignored-extensions '("semantic.cache"))
|
|
|
|
(defun sqlplus-mode-file-regexp-list (mode-symbol-list)
|
|
(delq nil (mapcar (lambda (element)
|
|
(let ((fun-name (if (listp (cdr element)) (cadr element) (cdr element))))
|
|
(when (memq fun-name mode-symbol-list) (cons (car element) fun-name))))
|
|
auto-mode-alist)))
|
|
|
|
(defun sqlplus-find-project-files (root-dir mode-symbol-list predicate)
|
|
(let ((obj-file-regexp-list (delq nil (mapcar (lambda (element)
|
|
(let ((len (length element)))
|
|
(unless (and (> len 0)
|
|
(equal (elt element (1- len)) ?/))
|
|
(concat (regexp-quote element) "$"))))
|
|
(append sqlplus-proj-ignored-extensions completion-ignored-extensions))))
|
|
(mode-file-regexp-list (sqlplus-mode-file-regexp-list mode-symbol-list))) ; (file-path-regexp . major-mode-function-symbol)
|
|
(when (and mode-symbol-list
|
|
(not mode-file-regexp-list))
|
|
(error (format "No rules for %s major modes in auto-mode-alist." (mapconcat 'identity mode-symbol-list ", "))))
|
|
(sqlplus-proj-find-files root-dir
|
|
(lambda (file-name)
|
|
(and (not (string-match "#" file-name))
|
|
(not (string-match "semantic.cache" file-name))
|
|
(or (and (not mode-symbol-list)
|
|
(not (some (lambda (regexp)
|
|
(string-match regexp file-name))
|
|
obj-file-regexp-list)))
|
|
(and mode-symbol-list
|
|
(some (lambda (element)
|
|
(let ((freg (if (string-match "[$]" (car element))
|
|
(car element)
|
|
(concat (car element) "$"))))
|
|
(when (string-match freg file-name)
|
|
(cdr element))))
|
|
mode-file-regexp-list)))
|
|
(or (not predicate)
|
|
(funcall predicate file-name))))
|
|
(lambda (dir-path)
|
|
(not (string-match "/\\(\\.svn\\|CVS\\)$" dir-path))))))
|
|
|
|
|
|
(defun sqlplus-file-get-source (connect-string object-name object-type &optional batch-mode)
|
|
(interactive
|
|
(progn
|
|
(push (point-marker) plsql-mark-backward-list)
|
|
(list sqlplus-connect-string (thing-at-point 'symbol) nil)))
|
|
(unless object-name
|
|
(error "Nothing to search"))
|
|
(let* ((root-dir (or (and (not object-type)
|
|
(eq major-mode 'plsql-mode)
|
|
(buffer-file-name)
|
|
(sqlplus-get-project-root-dir (buffer-file-name)))
|
|
(sqlplus-get-root-dir connect-string)
|
|
(sqlplus-set-project-for-connect-string connect-string)
|
|
(error "Root dir not set")))
|
|
(mode-symbol-list '(plsql-mode sql-mode))
|
|
(files-to-grep (sqlplus-find-project-files root-dir mode-symbol-list nil))
|
|
(temp-file-path (concat (file-name-as-directory temporary-file-directory) (make-temp-name "ide-")))
|
|
(search-buffer (get-buffer sqlplus-search-buffer-name))
|
|
(regexp (let ((index 0)
|
|
(len (length object-name))
|
|
result)
|
|
(setq result
|
|
(if object-type
|
|
(let ((type (cond ((equal object-type "FUNCTION") "PROCEDURE")
|
|
((equal object-type "PACKAGE BODY") "PACKAGE")
|
|
(t object-type))))
|
|
(cdr (assoc type sqlplus-object-types-regexps)))
|
|
(mapconcat 'cdr sqlplus-object-types-regexps "|")))
|
|
(unless result
|
|
(error "Not implemented"))
|
|
(while (and (< index (length result))
|
|
(string-match "#" result index))
|
|
(setq index (+ (match-beginning 0) len))
|
|
(setq result (replace-match object-name t t result)))
|
|
(setq index 0)
|
|
(while (and (< index (length result))
|
|
(string-match "[$]\\(\\\\b\\)?" result index))
|
|
(setq index (+ (match-end 0) 1))
|
|
(setq result (replace-match "\\$" t t result)))
|
|
result))
|
|
grep-command
|
|
grep-result)
|
|
(when search-buffer
|
|
(with-current-buffer search-buffer
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer))))
|
|
;; (message "Object type: %S, object name: %S, regexp: %S" object-type object-name regexp)
|
|
(with-temp-file temp-file-path
|
|
(dolist (path files-to-grep)
|
|
(insert (concat "'" path "'\n"))))
|
|
(let* ((grep-command (format "cat %s | xargs grep -nHiE -e '%s'" temp-file-path regexp))
|
|
(raw-grep-result (split-string (shell-command-to-string grep-command) "\n" t))
|
|
(grep-result (delq nil (mapcar (lambda (line)
|
|
(string-match "^\\(.*?\\):\\([0-9]+\\):\\(.*\\)$" line)
|
|
(let* ((path (match-string 1 line))
|
|
(line-no (string-to-number (match-string 2 line)))
|
|
(text (match-string 3 line))
|
|
(text2 text)
|
|
(syn-table (copy-syntax-table))
|
|
(case-fold-search t))
|
|
(modify-syntax-entry ?$ "w" syn-table)
|
|
(modify-syntax-entry ?# "w" syn-table)
|
|
(modify-syntax-entry ?_ "w" syn-table)
|
|
(with-syntax-table syn-table
|
|
(when (and (or (and (not object-type)
|
|
(> (length raw-grep-result) 1))
|
|
(equal object-type "SYNONYM"))
|
|
(string-match "\\<\\(for\\|from\\|on\\|as\\)\\>" text2))
|
|
(setq text2 (substring text2 0 (match-beginning 0))))
|
|
;; (message "GREP-RESULT: %s" text2)
|
|
(unless (or (not (string-match (concat "\\<" (regexp-quote object-name) "\\>") text2))
|
|
(string-match (concat "\\(--\\|\\<pro\\>\\|\\<prompt\\>\\|\\<drop\\>\\|\\<grant\\>\\).*\\<"
|
|
(regexp-quote object-name) "\\>") text2)
|
|
(and (or (and (not object-type)
|
|
(> (length raw-grep-result) 1))
|
|
(equal object-type "TRIGGER"))
|
|
(string-match "\\<\\(alter\\|disable\\|enable\\)\\>" text2))
|
|
(and (or (and (not object-type)
|
|
(string-match "\\<package\\>" text2)
|
|
current-prefix-arg)
|
|
(equal object-type "PACKAGE"))
|
|
(string-match "\\<body\\>" text2))
|
|
(and (or (and (not object-type)
|
|
(string-match "\\<package\\>" text2)
|
|
(not current-prefix-arg))
|
|
(equal object-type "PACKAGE BODY"))
|
|
(not (string-match "\\<body\\>" text2)))
|
|
(and (not object-type)
|
|
(not current-prefix-arg)
|
|
(string-match "[.]pks$" path)))
|
|
(list path line-no text)))))
|
|
raw-grep-result))))
|
|
(if batch-mode
|
|
grep-result
|
|
(cond ((not grep-result)
|
|
(error "Not found"))
|
|
((eql (length grep-result) 1)
|
|
(sqlplus-switch-to-buffer (caar grep-result) (cadar grep-result))
|
|
(when connect-string
|
|
(setq sqlplus-connect-string connect-string)))
|
|
(t
|
|
(let ((search-buffer (get-buffer-create sqlplus-search-buffer-name)))
|
|
(with-current-buffer search-buffer
|
|
(setq buffer-read-only t)
|
|
(let ((inhibit-read-only t))
|
|
(setq default-directory root-dir)
|
|
(erase-buffer)
|
|
(insert "Root dir: ")
|
|
(sqlplus-proj-insert-with-face root-dir 'font-lock-keyword-face)
|
|
(insert "; Range: ")
|
|
(sqlplus-proj-insert-with-face (mapconcat (lambda (sym) (sqlplus-mode-name-stringify sym)) mode-symbol-list ", ")
|
|
'font-lock-keyword-face)
|
|
(insert "; Object type: ")
|
|
(sqlplus-proj-insert-with-face (or object-type "unspecified") 'font-lock-keyword-face)
|
|
(insert "; Object name: ")
|
|
(sqlplus-proj-insert-with-face object-name 'font-lock-keyword-face)
|
|
(insert "\n\n")
|
|
(compilation-minor-mode 1)
|
|
(dolist (result grep-result)
|
|
(let ((relative-path (concat "./" (file-relative-name (car result) root-dir)))
|
|
(line-no (cadr result))
|
|
(text (caddr result)))
|
|
(put-text-property 0 (length relative-path) 'mouse-face 'highlight relative-path)
|
|
(insert relative-path)
|
|
(insert (format ":%S:1 %s\n" line-no text))))
|
|
(insert (format "\n%d matches found." (length grep-result)))
|
|
(goto-char (point-min))
|
|
(when (and grep-result (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t)))
|
|
(switch-to-buffer-other-window search-buffer)
|
|
(goto-line 1)
|
|
(goto-line 3))))))))))
|
|
|
|
(defun sqlplus-mode-name-stringify (mode-name)
|
|
(let ((name (format "%s" mode-name)))
|
|
(replace-regexp-in-string "-" " "
|
|
(capitalize
|
|
(if (string-match "^\\(.*\\)-mode" name)
|
|
(match-string 1 name)
|
|
name)))))
|
|
|
|
(defun sqlplus-proj-insert-with-face (string face)
|
|
(let ((point (point)))
|
|
(insert string)
|
|
(let ((overlay (make-overlay point (point))))
|
|
(overlay-put overlay 'face face))))
|
|
|
|
(defun sqlplus-set-project-for-connect-string (connect-string)
|
|
(if (featurep 'ide-skel)
|
|
;; Prepare sqlplus-root-dir-history (file-name-history) for user convenience
|
|
;; 0. previous project root
|
|
;; 1. current editor file project root
|
|
;; 2. previous choices
|
|
;; 3. new project roots
|
|
(let* ((prev-proj-root-dir (sqlplus-get-root-dir connect-string))
|
|
(last-sel-window (funcall 'ide-skel-get-last-selected-window))
|
|
(editor-file-proj-root-dir (when last-sel-window
|
|
(let* ((buffer (window-buffer last-sel-window))
|
|
(path (and buffer (buffer-file-name buffer)))
|
|
(project (and path (car (funcall 'ide-skel-proj-get-project-create path)))))
|
|
(when (funcall 'ide-skel-project-p project)
|
|
(funcall 'ide-skel-project-root-path project))))))
|
|
(setq sqlplus-root-dir-history
|
|
(delete-dups
|
|
(delq nil
|
|
(mapcar (lambda (dir)
|
|
(when dir
|
|
(directory-file-name (file-truename (substitute-in-file-name dir)))))
|
|
(append
|
|
(list editor-file-proj-root-dir prev-proj-root-dir)
|
|
sqlplus-root-dir-history
|
|
(mapcar (lambda (project) (funcall 'ide-skel-project-root-path project))
|
|
(symbol-value 'ide-skel-projects)))))))
|
|
(let* ((file-name-history (cdr sqlplus-root-dir-history))
|
|
(use-file-dialog nil)
|
|
(dir (directory-file-name (file-truename (substitute-in-file-name
|
|
(read-directory-name (format "Root dir for %s: " (car (refine-connect-string connect-string)))
|
|
(car sqlplus-root-dir-history)
|
|
(car sqlplus-root-dir-history)
|
|
t
|
|
nil))))))
|
|
(funcall 'ide-skel-proj-get-project-create dir)
|
|
(sqlplus-set-root-dir dir connect-string)
|
|
(message (format "Root dir for %s set to %s" (car (refine-connect-string connect-string)) dir))
|
|
dir))
|
|
(let* ((use-file-dialog nil)
|
|
(dir (directory-file-name (file-truename (substitute-in-file-name
|
|
(read-directory-name (format "Root dir for %s: " (car (refine-connect-string connect-string)))
|
|
nil nil t nil))))))
|
|
(sqlplus-set-root-dir dir connect-string)
|
|
(message (format "Root dir for %s set to %s" (car (refine-connect-string connect-string)) dir))
|
|
dir)))
|
|
|
|
;;; Plugin for ide-skel.el
|
|
|
|
(defstruct sqlplus-tab
|
|
id
|
|
name ; tab name
|
|
symbol ; view/sequence/schema/trigger/index/table/package/synonym/procedure
|
|
help-string
|
|
(display-start 1) ; display-start in side view window
|
|
(data nil) ; '(("name" . status)...), where status t means 'invalid'
|
|
draw-function ; parameters: sqlplus-tab
|
|
click-function ; parameters: event "@e"
|
|
(errors-count 0)
|
|
(refresh-in-progress t)
|
|
update-select)
|
|
|
|
(defvar sqlplus-side-view-connect-string nil)
|
|
(make-variable-buffer-local 'sqlplus-side-view-connect-string)
|
|
|
|
(defvar sqlplus-side-view-active-tab nil)
|
|
(make-variable-buffer-local 'sqlplus-side-view-active-tab)
|
|
|
|
(defvar sqlplus-side-view-tabset nil)
|
|
(make-variable-buffer-local 'sqlplus-side-view-tabset)
|
|
|
|
(defface sqlplus-side-view-face '((t :inherit variable-pitch :height 0.8))
|
|
"Default face used in right view"
|
|
:group 'sqlplus)
|
|
|
|
(defvar sqlplus-side-view-keymap nil)
|
|
(unless sqlplus-side-view-keymap
|
|
(setq sqlplus-side-view-keymap (make-sparse-keymap))
|
|
(define-key sqlplus-side-view-keymap [mode-line down-mouse-1] 'ignore)
|
|
(define-key sqlplus-side-view-keymap [mode-line mouse-1] 'sqlplus-side-view-tab-click))
|
|
|
|
(defun sqlplus-side-view-tab-click (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((previous-sel-tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset))
|
|
(target (posn-string (event-start event)))
|
|
(tab-info (get-text-property (cdr target) 'tab-info (car target))))
|
|
(setf (sqlplus-tab-display-start previous-sel-tab-info) (line-number-at-pos (window-start)))
|
|
(setq sqlplus-side-view-active-tab (sqlplus-tab-id tab-info))
|
|
(sqlplus-side-view-redraw (current-buffer) t)
|
|
(sqlplus-side-view-buffer-mode-line))))
|
|
|
|
(defun sqlplus-side-view-buffer-mode-line ()
|
|
(let* ((separator (propertize " "
|
|
'face 'header-line
|
|
'display '(space :width 0.2)
|
|
'pointer 'arrow)))
|
|
(setq mode-line-format
|
|
(concat separator
|
|
(mapconcat (lambda (tab)
|
|
(let ((face (if (eq (sqlplus-tab-id tab) sqlplus-side-view-active-tab)
|
|
'tabbar-selected
|
|
'tabbar-unselected))
|
|
(help-echo (concat (sqlplus-tab-help-string tab)
|
|
(if (> (sqlplus-tab-errors-count tab) 0)
|
|
(format "\n(%s error%s)" (sqlplus-tab-errors-count tab)
|
|
(if (> (sqlplus-tab-errors-count tab) 1) "s" ""))
|
|
""))))
|
|
(propertize (format " %s " (sqlplus-tab-name tab))
|
|
'local-map sqlplus-side-view-keymap
|
|
'tab-info tab
|
|
'help-echo help-echo
|
|
'mouse-face 'tabbar-highlight
|
|
'face (if (> (sqlplus-tab-errors-count tab) 0)
|
|
(list '(foreground-color . "red") face)
|
|
face)
|
|
'pointer 'hand)))
|
|
sqlplus-side-view-tabset
|
|
separator)
|
|
separator))))
|
|
|
|
(defun sqlplus-side-view-click-on-default-handler (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((posn-point (posn-point (event-start event)))
|
|
(object-name (get-text-property posn-point 'object-name))
|
|
(object-type (get-text-property posn-point 'object-type))
|
|
(type (car event)))
|
|
(when (eq type 'mouse-3)
|
|
(setq type (car (x-popup-menu t (append (list 'keymap object-name)
|
|
(list '(sqlplus-refresh-side-view-buffer "Refresh" t))
|
|
(list '(mouse-1 "Get source from Oracle" t))
|
|
(list '(M-mouse-1 "Search source in filesystem" t))
|
|
(list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t))
|
|
)))))
|
|
(cond ((eq type 'mouse-1)
|
|
(sqlplus-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'C-M-mouse-1)
|
|
(sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string))
|
|
((eq type nil))
|
|
(t
|
|
(condition-case err
|
|
(funcall type)
|
|
(error nil)))))))
|
|
|
|
(defun sqlplus-side-view-click-on-index-handler (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((posn-point (posn-point (event-start event)))
|
|
(object-name (get-text-property posn-point 'object-name))
|
|
(object-type (get-text-property posn-point 'object-type))
|
|
(type (car event)))
|
|
(when (eq type 'mouse-3)
|
|
(setq type (car (x-popup-menu t (append (list 'keymap object-name)
|
|
(list '(sqlplus-refresh-side-view-buffer "Refresh" t))
|
|
(list '(mouse-1 "Get source from Oracle" t))
|
|
(list '(M-mouse-1 "Search source in filesystem" t))
|
|
(list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t))
|
|
)))))
|
|
(cond ((eq type 'mouse-1)
|
|
(sqlplus-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'C-M-mouse-1)
|
|
(sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string))
|
|
((eq type nil))
|
|
(t
|
|
(condition-case err
|
|
(funcall type)
|
|
(error nil)))))))
|
|
|
|
(defun sqlplus-side-view-click-on-schema-handler (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((posn-point (posn-point (event-start event)))
|
|
(object-name (get-text-property posn-point 'object-name))
|
|
(object-type (get-text-property posn-point 'object-type))
|
|
(last-selected-win (funcall 'ide-skel-get-last-selected-window))
|
|
(type (car event)))
|
|
(when (eq type 'mouse-3)
|
|
(setq type (car (x-popup-menu t (append (list 'keymap object-name)
|
|
(list '(sqlplus-refresh-side-view-buffer "Refresh" t))
|
|
(list '(mouse-1 "Connect to schema" t))
|
|
(list '(M-mouse-1 "Search source in filesystem" t))
|
|
(list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t))
|
|
)))))
|
|
(cond ((eq type 'mouse-1)
|
|
(when (string-match "@.*$" sqlplus-side-view-connect-string)
|
|
(let* ((cs (downcase (concat object-name (match-string 0 sqlplus-side-view-connect-string))))
|
|
(pair (sqlplus-read-connect-string cs cs)))
|
|
(select-window (or last-selected-win (funcall 'ide-skel-get-editor-window)))
|
|
(sqlplus (car pair) (concat (cadr pair) (concat "." sqlplus-session-file-extension))))))
|
|
((eq type 'M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'C-M-mouse-1)
|
|
(sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string))
|
|
((eq type nil))
|
|
(t
|
|
(condition-case err
|
|
(funcall type)
|
|
(error nil))))
|
|
(select-window (funcall 'ide-skel-get-last-selected-window)))))
|
|
|
|
(defun sqlplus-side-view-click-on-table-handler (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((posn-point (posn-point (event-start event)))
|
|
(object-name (get-text-property posn-point 'object-name))
|
|
(object-type (get-text-property posn-point 'object-type))
|
|
(type (car event)))
|
|
(when (eq type 'mouse-3)
|
|
(setq type (car (x-popup-menu t (append (list 'keymap object-name)
|
|
(list '(sqlplus-refresh-side-view-buffer "Refresh" t))
|
|
(list '(mouse-1 "Show description" t))
|
|
(list '(C-mouse-1 "Select *" t))
|
|
(list '(S-mouse-1 "Get source from Oracle" t))
|
|
(list '(M-mouse-1 "Search source in filesystem" t))
|
|
(list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t))
|
|
)))))
|
|
(cond ((eq type 'mouse-1)
|
|
(sqlplus-execute sqlplus-side-view-connect-string
|
|
(sqlplus-fontify-string sqlplus-side-view-connect-string (format "desc %s;" object-name))
|
|
nil nil))
|
|
((eq type 'C-mouse-1)
|
|
(sqlplus-execute sqlplus-side-view-connect-string
|
|
(sqlplus-fontify-string sqlplus-side-view-connect-string (format "select * from %s;" object-name))
|
|
nil nil))
|
|
((eq type 'S-mouse-1)
|
|
(sqlplus-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'C-M-mouse-1)
|
|
(sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string))
|
|
((eq type nil))
|
|
(t
|
|
(condition-case err
|
|
(funcall type)
|
|
(error nil))))
|
|
(select-window (funcall 'ide-skel-get-last-selected-window)))))
|
|
|
|
(defun sqlplus-side-view-click-on-package-handler (event)
|
|
(interactive "@e")
|
|
(with-selected-window (posn-window (event-start event))
|
|
(let* ((posn-point (posn-point (event-start event)))
|
|
(object-name (get-text-property posn-point 'object-name))
|
|
(object-type (get-text-property posn-point 'object-type))
|
|
(type (car event)))
|
|
(when (eq type 'mouse-3)
|
|
(setq type (car (x-popup-menu t (append (list 'keymap object-name)
|
|
(list '(sqlplus-refresh-side-view-buffer "Refresh" t))
|
|
(list '(S-mouse-1 "Get package header from Oracle" t))
|
|
(list '(mouse-1 "Get package body from Oracle" t))
|
|
(list '(S-M-mouse-1 "Search header source in filesystem" t))
|
|
(list '(M-mouse-1 "Search body source in filesystem" t))
|
|
(list (list 'C-M-mouse-1 (concat "Set root dir for " (car (refine-connect-string sqlplus-side-view-connect-string))) t))
|
|
)))))
|
|
(cond ((eq type 'S-mouse-1)
|
|
(sqlplus-get-source sqlplus-side-view-connect-string object-name object-type))
|
|
((eq type 'mouse-1)
|
|
(sqlplus-get-source sqlplus-side-view-connect-string object-name "PACKAGE BODY"))
|
|
((eq type 'M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name "PACKAGE BODY"))
|
|
((eq type 'S-M-mouse-1)
|
|
(sqlplus-file-get-source sqlplus-side-view-connect-string object-name "PACKAGE"))
|
|
((eq type 'C-M-mouse-1)
|
|
(sqlplus-set-project-for-connect-string sqlplus-side-view-connect-string))
|
|
((eq type nil))
|
|
(t
|
|
(condition-case err
|
|
(funcall type)
|
|
(error nil)))))))
|
|
|
|
(defun sqlplus-side-view-default-draw-panel (tab-info click-function)
|
|
(let ((pairs (sort (sqlplus-tab-data tab-info)
|
|
(lambda (pair1 pair2) (string< (car pair1) (car pair2)))))
|
|
(type-name (upcase (symbol-name (sqlplus-tab-symbol tab-info)))))
|
|
(dolist (pair pairs)
|
|
(let* ((label (format " % -100s" (car pair)))
|
|
(km (make-sparse-keymap)))
|
|
(define-key km [down-mouse-1] 'ignore)
|
|
(define-key km [mouse-1] click-function)
|
|
(define-key km [C-down-mouse-1] 'ignore)
|
|
(define-key km [C-mouse-1] click-function)
|
|
(define-key km [S-down-mouse-1] 'ignore)
|
|
(define-key km [S-mouse-1] click-function)
|
|
(define-key km [down-mouse-3] 'ignore)
|
|
(define-key km [mouse-3] click-function)
|
|
(setq label (propertize label
|
|
'mouse-face 'ide-skel-highlight-face
|
|
'face (if (cdr pair)
|
|
'(sqlplus-side-view-face (foreground-color . "red"))
|
|
'sqlplus-side-view-face)
|
|
'local-map km
|
|
'pointer 'hand
|
|
'object-name (car pair)
|
|
'object-type type-name))
|
|
(insert label)
|
|
(insert "\n")))))
|
|
|
|
(defun sqlplus-refresh-side-view-buffer ()
|
|
(let* ((tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset))
|
|
(update-select (sqlplus-tab-update-select tab-info)))
|
|
(unless (sqlplus-tab-refresh-in-progress tab-info)
|
|
(sqlplus-hidden-select sqlplus-side-view-connect-string update-select 'sqlplus-my-update-handler))))
|
|
|
|
(defun sqlplus-get-default-update-select (symbol)
|
|
(concat "select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n"
|
|
"where object_name not like 'BIN$%'\n"
|
|
(format "and object_type = '%s';" (upcase (symbol-name symbol)))))
|
|
|
|
(defun sqlplus-create-side-view-buffer (connect-string)
|
|
(let* ((original-connect-string connect-string)
|
|
(connect-string (car (refine-connect-string connect-string)))
|
|
(buffer (funcall 'ide-skel-get-side-view-buffer-create
|
|
(concat " Ide Skel Right View SQL " connect-string)
|
|
'right "SQL" (concat "SQL Panel for " connect-string)
|
|
(lambda (editor-buffer)
|
|
(let ((connect-string sqlplus-side-view-connect-string))
|
|
(with-current-buffer editor-buffer
|
|
(and connect-string
|
|
(equal (car (refine-connect-string sqlplus-connect-string))
|
|
(car (refine-connect-string connect-string)))
|
|
)))))))
|
|
(with-current-buffer buffer
|
|
(set 'ide-skel-tabbar-menu-function
|
|
(lambda ()
|
|
(let ((tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset)))
|
|
(list
|
|
(unless (sqlplus-tab-refresh-in-progress tab-info)
|
|
'(sqlplus-refresh-side-view-buffer "Refresh" t))))))
|
|
(setq sqlplus-side-view-connect-string original-connect-string
|
|
sqlplus-side-view-active-tab 0
|
|
sqlplus-side-view-tabset
|
|
(list
|
|
(make-sqlplus-tab :id 0 :name "Tab" :symbol 'table :help-string "Tables" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'table)
|
|
:click-function 'sqlplus-side-view-click-on-table-handler)
|
|
(make-sqlplus-tab :id 1 :name "Vie" :symbol 'view :help-string "Views" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'view)
|
|
:click-function 'sqlplus-side-view-click-on-table-handler)
|
|
(make-sqlplus-tab :id 2 :name "Idx" :symbol 'index :help-string "Indexes" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'index)
|
|
:click-function 'sqlplus-side-view-click-on-index-handler)
|
|
(make-sqlplus-tab :id 3 :name "Tri" :symbol 'trigger :help-string "Triggers" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'trigger)
|
|
:click-function 'sqlplus-side-view-click-on-default-handler)
|
|
(make-sqlplus-tab :id 4 :name "Seq" :symbol 'sequence :help-string "Sequences" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'sequence)
|
|
:click-function 'sqlplus-side-view-click-on-default-handler)
|
|
(make-sqlplus-tab :id 5 :name "Syn" :symbol 'synonym :help-string "Synonyms" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'synonym)
|
|
:click-function 'sqlplus-side-view-click-on-default-handler)
|
|
(make-sqlplus-tab :id 6 :name "Pkg" :symbol 'package :help-string "PL/SQL Packages" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (sqlplus-get-default-update-select 'package)
|
|
:click-function 'sqlplus-side-view-click-on-package-handler)
|
|
(make-sqlplus-tab :id 7 :name "Prc" :symbol 'procedure :help-string "PL/SQL Functions & Procedures" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select (concat "select object_name, object_type, decode( status, 'INVALID', 'I', ' ' ) from user_objects\n"
|
|
"where object_name not like 'BIN$%'\n"
|
|
"and object_type in ('FUNCTION', 'PROCEDURE');")
|
|
:click-function 'sqlplus-side-view-click-on-default-handler)
|
|
(make-sqlplus-tab :id 8 :name "Sch" :symbol 'schema :help-string "Schemas" :draw-function 'sqlplus-side-view-default-draw-panel
|
|
:update-select "select username, 'SCHEMA', ' ' from all_users where username not like 'BIN$%';"
|
|
:click-function 'sqlplus-side-view-click-on-schema-handler)
|
|
))
|
|
(sqlplus-side-view-buffer-mode-line))
|
|
buffer))
|
|
|
|
(defun sqlplus-side-view-redraw (sql-view-buffer &optional window-start-from-tab-info)
|
|
(with-current-buffer sql-view-buffer
|
|
(let* ((point (point))
|
|
(tab-info (nth sqlplus-side-view-active-tab sqlplus-side-view-tabset))
|
|
(window-start (when (and (symbol-value 'ide-skel-current-right-view-window)
|
|
(eq (window-buffer (symbol-value 'ide-skel-current-right-view-window)) (current-buffer)))
|
|
(if window-start-from-tab-info
|
|
(sqlplus-tab-display-start tab-info)
|
|
(line-number-at-pos (window-start (symbol-value 'ide-skel-current-right-view-window)))))))
|
|
(let ((inhibit-read-only t))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(when (sqlplus-tab-draw-function tab-info)
|
|
(funcall (sqlplus-tab-draw-function tab-info) tab-info (sqlplus-tab-click-function tab-info))))
|
|
(if window-start
|
|
(let ((pos (save-excursion
|
|
(goto-line window-start)
|
|
(beginning-of-line)
|
|
(point))))
|
|
(set-window-start (symbol-value 'ide-skel-current-right-view-window) pos)
|
|
(setf (sqlplus-tab-display-start tab-info) window-start))
|
|
(goto-char point)
|
|
(beginning-of-line)))))
|
|
|
|
(defun sqlplus-side-view-update-data (connect-string alist)
|
|
(let* ((connect-string (car (refine-connect-string connect-string)))
|
|
(sql-view-buffer (sqlplus-get-side-view-buffer connect-string))
|
|
was-proc)
|
|
(when sql-view-buffer
|
|
(with-current-buffer sql-view-buffer
|
|
(dolist (pair alist)
|
|
(let* ((symbol (if (eq (car pair) 'function) 'procedure (car pair)))
|
|
(data-list (cdr pair))
|
|
(tab-info (some (lambda (tab)
|
|
(when (eq (sqlplus-tab-symbol tab) symbol)
|
|
tab))
|
|
sqlplus-side-view-tabset)))
|
|
(when tab-info
|
|
(setf (sqlplus-tab-refresh-in-progress tab-info) nil)
|
|
(setf (sqlplus-tab-data tab-info)
|
|
(if (and (eq symbol 'procedure)
|
|
was-proc)
|
|
(append (sqlplus-tab-data tab-info) (copy-list data-list))
|
|
data-list))
|
|
(when (eq symbol 'procedure)
|
|
(setq was-proc t))
|
|
(setf (sqlplus-tab-errors-count tab-info)
|
|
(count t (mapcar 'cdr data-list)))
|
|
(when (eql sqlplus-side-view-active-tab (sqlplus-tab-id tab-info))
|
|
(sqlplus-side-view-redraw (current-buffer))))))
|
|
(sqlplus-side-view-buffer-mode-line)
|
|
(force-mode-line-update)))))
|
|
|
|
(defun sqlplus-side-view-window-function (side event &rest list)
|
|
(when (and (eq side 'right)
|
|
(symbol-value 'ide-skel-current-right-view-window)
|
|
(with-current-buffer (symbol-value 'ide-skel-current-editor-buffer)
|
|
sqlplus-connect-string))
|
|
(cond ((memq event '(show editor-buffer-changed))
|
|
(let ((sql-view-buffer (sqlplus-get-side-view-buffer (with-current-buffer (symbol-value 'ide-skel-current-editor-buffer)
|
|
sqlplus-connect-string))))
|
|
(when sql-view-buffer
|
|
(with-current-buffer sql-view-buffer
|
|
(set 'ide-skel-tabbar-enabled t)
|
|
(funcall 'ide-skel-side-window-switch-to-buffer (symbol-value 'ide-skel-current-right-view-window) sql-view-buffer)))))))
|
|
nil)
|
|
|
|
(add-hook 'ide-skel-side-view-window-functions 'sqlplus-side-view-window-function)
|
|
|
|
|
|
(provide 'sqlplus)
|
|
|
|
;;; sqlplus.el ends here
|