aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2004-05-01 19:23:22 +0000
committerKaroly Lorentey2004-05-01 19:23:22 +0000
commitb160ff41a813213adfa745a9d009ab638a22d7b1 (patch)
treecee50a478285aa9d2d5e99acbcf31f64c7dc3cde /lisp
parente6da77e898ea743bc416517542eae446e573b6b5 (diff)
parent4ae73f87a0f3ab6f9b7cdca19a3df40d945fc7a9 (diff)
downloademacs-b160ff41a813213adfa745a9d009ab638a22d7b1.tar.gz
emacs-b160ff41a813213adfa745a9d009ab638a22d7b1.zip
Merged in changes from CVS trunk.
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-262 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-266 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-267 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-156
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog189
-rw-r--r--lisp/bindings.el9
-rw-r--r--lisp/calendar/diary-lib.el149
-rw-r--r--lisp/cus-edit.el1
-rw-r--r--lisp/delsel.el2
-rw-r--r--lisp/diff.el2
-rw-r--r--lisp/dired-aux.el20
-rw-r--r--lisp/emacs-lisp/find-func.el41
-rw-r--r--lisp/emacs-lisp/lisp.el57
-rw-r--r--lisp/emulation/cua-base.el180
-rw-r--r--lisp/emulation/cua-rect.el25
-rw-r--r--lisp/files.el2
-rw-r--r--lisp/follow.el2
-rw-r--r--lisp/help-fns.el60
-rw-r--r--lisp/help-mode.el17
-rw-r--r--lisp/info-look.el16
-rw-r--r--lisp/international/titdic-cnv.el30
-rw-r--r--lisp/isearch.el36
-rw-r--r--lisp/menu-bar.el2
-rw-r--r--lisp/mouse.el16
-rw-r--r--lisp/outline.el22
-rw-r--r--lisp/progmodes/cfengine.el7
-rw-r--r--lisp/progmodes/compile.el15
-rw-r--r--lisp/progmodes/f90.el11
-rw-r--r--lisp/progmodes/fortran.el3
-rw-r--r--lisp/progmodes/python.el45
-rw-r--r--lisp/progmodes/sql.el933
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/smerge-mode.el6
-rw-r--r--lisp/subr.el3
-rw-r--r--lisp/xml.el42
31 files changed, 1379 insertions, 567 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8a1bba88874..4b61e5ceabb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,187 @@
12004-05-01 Kenichi Handa <handa@m17n.org>
2
3 * international/titdic-cnv.el (miscdic-convert): Don't generate a
4 quail file if it is up to date.
5
62004-04-30 Juri Linkov <juri@jurta.org>
7
8 * cus-edit.el (custom-mode-map):
9 Add key binding `C-x C-s' to `Custom-save'.
10
11 * outline.el (outline-blank-line): New var.
12 (outline-next-preface, outline-show-heading)
13 (outline-end-of-subtree): Use it.
14
15 * dired-aux.el (dired-touch-initial): New fun.
16 (dired-do-chxxx): Call it for op-symbol `touch'.
17 (dired-diff): Use `dired-dwim-target-directory'
18 if current dired buffer has no buffer mark.
19
20 * bindings.el (propertized-buffer-identification):
21 Replace `(:weight bold)' by `Buffer-menu-buffer-face'.
22 Add C-M-arrow keys for consistency.
23
24 * files.el (confirm-kill-emacs):
25 Change group from top-level `emacs' to `convenience'.
26
27 * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun):
28 Push mark on the first call of successive command calls.
29 (insert-pair): New fun created from `insert-parentheses' with
30 `open' and `close' arguments added. Enclose active regions
31 in paired characters. Compare adjacent characters syntax with
32 inserted characters syntax before inserting a space.
33 (insert-parentheses): Call `insert-pair' with ?\( ?\).
34
35 * delsel.el: Don't put `delete-selection' property
36 on `insert-parentheses' symbol to take advantage of
37 region handling in `insert-pair' function.
38 Suggested by Stephan Stahl <stahl@eos.franken.de>
39
402004-04-30 Kim F. Storm <storm@cua.dk>
41
42 * emulation/cua-base.el: Add support for changing cursor types;
43 based on patch from Michael Mauger.
44 (cua-normal-cursor-color, cua-read-only-cursor-color)
45 (cua-overwrite-cursor-color, cua-global-mark-cursor-color):
46 Customization cursor type and/or cursor color.
47 (cua--update-indications): Handle cursor type changes.
48 (cua-mode): Update cursor indications if enabled.
49
50 * menu-bar.el (menu-bar-options-menu): Change menu text for CUA.
51
52 * mouse.el (mouse-drag-copy-region): New defcustom.
53 (mouse-set-region, mouse-drag-region-1): Use it.
54
55 * simple.el (kill-ring-save): If region face background color is
56 unspecified (if no highlighting), show extent of fully visible
57 region even if transient-mark-mode is enabled.
58
59 * emulation/cua-base.el (cua--standard-movement-commands):
60 Add cua-scroll-up and cua-scroll-down.
61 (cua-scroll-up, cua-scroll-down): New commands.
62 (cua--init-keymaps): Remap scroll-up and scroll-down.
63
64 * emulation/cua-rect.el (cua--convert-rectangle-as):
65 New defmacro.
66 (cua-upcase-rectangle, cua-downcase-rectangle): Use it.
67 (cua-upcase-initials-rectangle, cua-capitalize-rectangle):
68 New commands (suggested by Jordan Breeding)..
69
702004-04-30 Juanma Barranquero <lektu@terra.es>
71
72 * smerge-mode.el (smerge-diff-switches): Fix typo in docstring.
73
742004-04-30 Mario Lang <mlang@delysid.org>
75
76 * diff.el (diff-switches): Fix typo in docstring.
77
782004-04-30 Alex Schroeder <alex@gnu.org>
79
80 * xml.el (xml-debug-print-internal): Don't add newline and
81 indentation to text nodes and write empty elements as empty tags
82 instead of opening and closing tags.
83 (xml-debug-print): Take optional indent-string argument.
84 (xml-print): Alias for xml-debug-print.
85
862004-04-30 Glenn Morris <gmorris@ast.cam.ac.uk>
87
88 * progmodes/fortran.el (fortran-fill): Use local var `bol' rather
89 than duplicate call to `line-beginning-position'.
90
91 * progmodes/f90.el (f90-get-present-comment-type): Return
92 whitespace, as well as comment chars, for consistent filling
93 of comment blocks. Use `match-string-no-properties'.
94 (f90-break-line): Do not leave trailing whitespace when filling
95 comments.
96
972004-04-30 Dave Love <fx@gnu.org>
98
99 * calendar/diary-lib.el (diary-outlook-formats): New variable.
100 (diary-from-outlook-internal, diary-from-outlook)
101 (diary-from-outlook-gnus, diary-from-outlook-rmail): New
102 functions to import diary entries from Outlook-format
103 appointments in mail messages.
104
1052004-04-29 Stefan Monnier <monnier@iro.umontreal.ca>
106
107 * progmodes/python.el (python-send-command): New fun.
108 (python-send-region, python-load-file): Use it.
109
110 * progmodes/compile.el (compilation-last-buffer): Add var alias.
111
112 * help-fns.el (help-C-file-name): Use new subr-name.
113 Prepend `src/' to the file name.
114 (help-C-source-directory, help-subr-name, help-find-C-source): Remove.
115 (describe-function-1, describe-variable): Only find a C source file
116 name if DOC is already loaded.
117
118 * help-mode.el (help-function-def, help-variable-def):
119 Use the new find-function-search-for-symbol functionality.
120 Allow FILE to be `C-source'.
121
122 * emacs-lisp/find-func.el (find-function-C-source-directory): New var.
123 (find-function-C-source): New fun.
124 (find-function-search-for-symbol): Use it.
125
1262004-03-29 Michael Mauger <mmaug@yahoo.com>
127
128 * progmodes/sql.el (sql-product-alist): Rename variable
129 `sql-product-support'. Add Postgres login parameters.
130 (sql-set-product, sql-product-feature): Update with renamed
131 variable.
132 (sql-connect-postgres): Add username prompt.
133 (sql-imenu-generic-expression, sql-mode-font-lock-object-name):
134 Make patterns less product specific.
135 (sql-xemacs-p, sql-emacs19-p): Add flags for emacs variants.
136 (sql-mode-abbrev-table): Modify initialization.
137 (sql-builtin-face): Add variable.
138 (sql-keywords-re): Add macro.
139 (sql-mode-ansi-font-lock-keywords): Update for ANSI-92.
140 (sql-mode-oracle-font-lock-keywords): Update for Oracle 9i.
141 (sql-mode-postgres-font-lock-keywords): Update for Postgres 7.3.
142 (sql-mode-mysql-font-lock-keywords): Update for MySql 4.0.
143 (sql-mode-linter-font-lock-keywords)
144 (sql-mode-ms-font-lock-keywords): Use `sql-keywords-re' macro.
145 (sql-mode-sybase-font-lock-keywords)
146 (sql-mode-informix-font-lock-keywords)
147 (sql-mode-interbase-font-lock-keywords)
148 (sql-mode-ingres-font-lock-keywords)
149 (sql-mode-solid-font-lock-keywords)
150 (sql-mode-sqlite-font-lock-keywords)
151 (sql-mode-db2-font-lock-keywords): Default to nil.
152 (sql-product-font-lock): Always highlight ANSI keywords.
153 (sql-add-product-keywords): Made similar to
154 `font-lock-add-keywords'.
155 (sql-send-string): Add function.
156
1572004-04-29 Dave Love <fx@gnu.org>
158
159 * progmodes/cfengine.el (cfengine-beginning-of-defun)
160 (cfengine-end-of-defun): Ensure progress through buffer.
161
162 * info-look.el (cfengine-mode): Accept a terminal ().
163
1642004-04-29 Juri Linkov <juri@jurta.org>
165
166 * isearch.el (isearch-mode-map): Bind \C-w to isearch-yank-word
167 instead of isearch-yank-word-or-char. Add new key bindings for
168 isearch-yank-char to \C-f, and isearch-del-char to \C-b.
169 (isearch-del-char): New fun.
170 (isearch-forward, isearch-edit-string): Update docstring.
171 (isearch-yank-char): Doc fix.
172 (isearch-other-meta-char): Restore point after scrolling.
173
174 * progmodes/compile.el (compilation-context-lines): Add nil option
175 to disable compilation output window scrolling.
176 (compilation-set-window): Use it.
177
178 * outline.el (outline-next-preface, outline-show-heading):
179 Don't leave unhidden blank line before heading.
180 (outline-end-of-subtree): Include last newline into subtree.
181 (hide-entry): Leave point at beginning of heading instead of end.
182 (outline-up-heading): Push mark for the first call of successive
183 command calls.
184
12004-04-28 Luc Teirlinck <teirllm@auburn.edu> 1852004-04-28 Luc Teirlinck <teirllm@auburn.edu>
2 186
3 * comint.el (comint-prompt-read-only): New variable. 187 * comint.el (comint-prompt-read-only): New variable.
@@ -22,10 +206,9 @@
222004-04-28 Nick Roberts <nickrob@gnu.org> 2062004-04-28 Nick Roberts <nickrob@gnu.org>
23 207
24 * progmodes/gdb-ui.el (gdb-frame-breakpoints-buffer) 208 * progmodes/gdb-ui.el (gdb-frame-breakpoints-buffer)
25 (gdb-frame-stack-buffer, gdb-frame-threads-buffer) 209 (gdb-frame-assembler-buffer, gdb-frame-threads-buffer)
26 (gdb-frame-registers-buffer, gdb-frame-locals-buffer) 210 (gdb-frame-registers-buffer, gdb-frame-locals-buffer)
27 (gdb-frame-gdb-buffer, gdb-frame-assembler-buffer): Use 211 (gdb-frame-gdb-buffer, gdb-frame-stack-buffer): Use selected-window.
28 selected-window.
29 212
30 * progmodes/gud.el (gud-common-init): Throw an error if program is 213 * progmodes/gud.el (gud-common-init): Throw an error if program is
31 already running under gdb. 214 already running under gdb.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 280ca028842..a04114b58f2 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -460,7 +460,7 @@ Menu of mode operations in the mode line.")
460FMT is a format specifier such as \"%12b\". This function adds 460FMT is a format specifier such as \"%12b\". This function adds
461text properties for face, help-echo, and local-map to it." 461text properties for face, help-echo, and local-map to it."
462 (list (propertize fmt 462 (list (propertize fmt
463 'face '(:weight bold) 463 'face 'Buffer-menu-buffer-face
464 'help-echo 464 'help-echo
465 (purecopy "mouse-1: previous buffer, mouse-3: next buffer") 465 (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
466 'local-map mode-line-buffer-identification-keymap))) 466 'local-map mode-line-buffer-identification-keymap)))
@@ -945,6 +945,13 @@ language you are using."
945;; This is "move to the clipboard", or as close as we come. 945;; This is "move to the clipboard", or as close as we come.
946(global-set-key [S-delete] 'kill-region) 946(global-set-key [S-delete] 'kill-region)
947 947
948(global-set-key [C-M-left] 'backward-sexp)
949(global-set-key [C-M-right] 'forward-sexp)
950(global-set-key [C-M-up] 'backward-up-list)
951(global-set-key [C-M-down] 'down-list)
952(global-set-key [C-M-home] 'beginning-of-defun)
953(global-set-key [C-M-end] 'end-of-defun)
954
948(define-key esc-map "\C-f" 'forward-sexp) 955(define-key esc-map "\C-f" 'forward-sexp)
949(define-key esc-map "\C-b" 'backward-sexp) 956(define-key esc-map "\C-b" 'backward-sexp)
950(define-key esc-map "\C-u" 'backward-up-list) 957(define-key esc-map "\C-u" 'backward-up-list)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index eba932847c0..b8a1d958e0d 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1859,6 +1859,155 @@ names."
1859 "Forms to highlight in diary-mode") 1859 "Forms to highlight in diary-mode")
1860 1860
1861 1861
1862;; Following code from Dave Love <fx@gnu.org>.
1863;; Import Outlook-format appointments from mail messages in Gnus or
1864;; Rmail using command `diary-from-outlook'. This, or the specialized
1865;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail',
1866;; could be run from hooks to notice appointments automatically (in
1867;; which case they will prompt about adding to the diary). The
1868;; message formats recognized are customizable through
1869;; `diary-outlook-formats'.
1870
1871(defcustom diary-outlook-formats
1872 '(
1873 ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ...
1874 ;; [Current UK format? The timezone is meaningless. Sometimes the
1875 ;; Where is missing.]
1876 ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \
1877\\([^ ]+\\) [^\n]+
1878\[^\n]+
1879\\(?:Where: \\([^\n]+\\)\n+\\)?
1880\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*"
1881 . "\\1\n \\2 %s, \\3")
1882 ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ...
1883 ;; [Old UK format?]
1884 ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \
1885\\([^ ]+\\) [^\n]+
1886\[^\n]+
1887\\(?:Where: \\([^\n]+\\)\\)?\n+"
1888 . "\\2 \\1 \\3\n \\4 %s, \\5")
1889 (
1890 ;; German format, apparently.
1891 "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$"
1892 . "\\1 \\2 \\3\n \\4 %s"))
1893 "Alist of regexps matching message text and replacement text.
1894
1895The regexp must match the start of the message text containing an
1896appointment, but need not include a leading `^'. If it matches the
1897current message, a diary entry is made from the corresponding
1898template. If the template is a string, it should be suitable for
1899passing to `replace-match', and so will have occurrences of `\\D' to
1900substitute the match for the Dth subexpression. It must also contain
1901a single `%s' which will be replaced with the text of the message's
1902Subject field. Any other `%' characters must be doubled, so that the
1903template can be passed to `format'.
1904
1905If the template is actually a function, it is called with the message
1906body text as argument, and may use `match-string' etc. to make a
1907template following the rules above."
1908 :type '(alist :key-type (regexp :tag "Regexp matching time/place")
1909 :value-type (choice
1910 (string :tag "Template for entry")
1911 (function :tag "Unary function providing template")))
1912 :version "21.4"
1913 :group 'diary)
1914
1915
1916;; Dynamically bound.
1917(defvar body)
1918(defvar subject)
1919
1920(defun diary-from-outlook-internal (&optional test-only)
1921 "Snarf a diary entry from a message assumed to be from MS Outlook.
1922Assumes `body' is bound to a string comprising the body of the message and
1923`subject' is bound to a string comprising its subject.
1924Arg TEST-ONLY non-nil means return non-nil if and only if the
1925message contains an appointment, don't make a diary entry."
1926 (catch 'finished
1927 (let (format-string)
1928 (dotimes (i (length diary-outlook-formats))
1929 (when (eq 0 (string-match (car (nth i diary-outlook-formats))
1930 body))
1931 (unless test-only
1932 (setq format-string (cdr (nth i diary-outlook-formats)))
1933 (save-excursion
1934 (save-window-excursion
1935 ;; Fixme: References to optional fields in the format
1936 ;; are treated literally, not replaced by the empty
1937 ;; string. I think this is an Emacs bug.
1938 (make-diary-entry
1939 (format (replace-match (if (functionp format-string)
1940 (funcall format-string body)
1941 format-string)
1942 t nil (match-string 0 body))
1943 subject))
1944 (save-buffer))))
1945 (throw 'finished t))))
1946 nil))
1947
1948(defun diary-from-outlook ()
1949 "Maybe snarf diary entry from current Outlook-generated message.
1950Currently knows about Gnus and Rmail modes."
1951 (interactive)
1952 (let ((func (cond
1953 ((eq major-mode 'rmail-mode)
1954 #'diary-from-outlook-rmail)
1955 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
1956 #'diary-from-outlook-gnus)
1957 (t (error "Don't know how to snarf in `%s'" major-mode)))))
1958 (if (interactive-p)
1959 (call-interactively func)
1960 (funcall func))))
1961
1962
1963(defvar gnus-article-mime-handles)
1964(defvar gnus-article-buffer)
1965
1966(autoload 'gnus-fetch-field "gnus-util")
1967(autoload 'gnus-narrow-to-body "gnus")
1968(autoload 'mm-get-part "mm-decode")
1969
1970(defun diary-from-outlook-gnus ()
1971 "Maybe snarf diary entry from Outlook-generated message in Gnus.
1972Add this to `gnus-article-prepare-hook' to notice appointments
1973automatically."
1974 (interactive)
1975 (with-current-buffer gnus-article-buffer
1976 (let ((subject (gnus-fetch-field "subject"))
1977 (body (if gnus-article-mime-handles
1978 ;; We're multipart. Don't get confused by part
1979 ;; buttons &c. Assume info is in first part.
1980 (mm-get-part (nth 1 gnus-article-mime-handles))
1981 (save-restriction
1982 (gnus-narrow-to-body)
1983 (buffer-string)))))
1984 (when (diary-from-outlook-internal t)
1985 (when (or (interactive-p)
1986 (y-or-n-p "Snarf diary entry? "))
1987 (diary-from-outlook-internal)
1988 (message "Diary entry added"))))))
1989
1990(custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
1991
1992
1993(defvar rmail-buffer)
1994
1995(defun diary-from-outlook-rmail ()
1996 "Maybe snarf diary entry from Outlook-generated message in Rmail."
1997 (interactive)
1998 (with-current-buffer rmail-buffer
1999 (let ((subject (mail-fetch-field "subject"))
2000 (body (buffer-substring (save-excursion
2001 (rfc822-goto-eoh)
2002 (point))
2003 (point-max))))
2004 (when (diary-from-outlook-internal t)
2005 (when (or (interactive-p)
2006 (y-or-n-p "Snarf diary entry? "))
2007 (diary-from-outlook-internal)
2008 (message "Diary entry added"))))))
2009
2010
1862(provide 'diary-lib) 2011(provide 'diary-lib)
1863 2012
1864;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 2013;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 951b14f7f05..11b91242cc2 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4023,6 +4023,7 @@ The format is suitable for use with `easy-menu-define'."
4023 (suppress-keymap custom-mode-map) 4023 (suppress-keymap custom-mode-map)
4024 (define-key custom-mode-map " " 'scroll-up) 4024 (define-key custom-mode-map " " 'scroll-up)
4025 (define-key custom-mode-map "\177" 'scroll-down) 4025 (define-key custom-mode-map "\177" 'scroll-down)
4026 (define-key custom-mode-map "\C-x\C-s" 'Custom-save)
4026 (define-key custom-mode-map "q" 'Custom-buffer-done) 4027 (define-key custom-mode-map "q" 'Custom-buffer-done)
4027 (define-key custom-mode-map "u" 'Custom-goto-parent) 4028 (define-key custom-mode-map "u" 'Custom-goto-parent)
4028 (define-key custom-mode-map "n" 'widget-forward) 4029 (define-key custom-mode-map "n" 'widget-forward)
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 88e23cb218e..d8e034a5f9f 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -123,8 +123,6 @@ any selection."
123(put 'newline 'delete-selection t) 123(put 'newline 'delete-selection t)
124(put 'open-line 'delete-selection 'kill) 124(put 'open-line 'delete-selection 'kill)
125 125
126(put 'insert-parentheses 'delete-selection t)
127
128;; This is very useful for cancelling a selection in the minibuffer without 126;; This is very useful for cancelling a selection in the minibuffer without
129;; aborting the minibuffer. 127;; aborting the minibuffer.
130(defun minibuffer-keyboard-quit () 128(defun minibuffer-keyboard-quit ()
diff --git a/lisp/diff.el b/lisp/diff.el
index 76b1b5e60a7..c985b66036e 100644
--- a/lisp/diff.el
+++ b/lisp/diff.el
@@ -36,7 +36,7 @@
36 36
37;;;###autoload 37;;;###autoload
38(defcustom diff-switches "-c" 38(defcustom diff-switches "-c"
39 "*A string or list of strings specifying switches to be be passed to diff." 39 "*A string or list of strings specifying switches to be passed to diff."
40 :type '(choice string (repeat string)) 40 :type '(choice string (repeat string))
41 :group 'diff) 41 :group 'diff)
42 42
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 0709e0cfe1c..b31d20782f3 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -64,7 +64,10 @@ With prefix arg, prompt for second argument SWITCHES,
64 (if default 64 (if default
65 (concat "(default " default ") ") 65 (concat "(default " default ") ")
66 "")) 66 ""))
67 (dired-current-directory) default t) 67 (if default
68 (dired-current-directory)
69 (dired-dwim-target-directory))
70 default t)
68 (if current-prefix-arg 71 (if current-prefix-arg
69 (read-string "Options for diff: " 72 (read-string "Options for diff: "
70 (if (stringp diff-switches) 73 (if (stringp diff-switches)
@@ -185,6 +188,18 @@ List has a form of (file-name full-file-name (attribute-list))"
185 (file-attributes full-file-name)))) 188 (file-attributes full-file-name))))
186 (directory-files dir))) 189 (directory-files dir)))
187 190
191
192(defun dired-touch-initial (files)
193 "Create initial input value for `touch' command."
194 (let (initial)
195 (while files
196 (let ((current (nth 5 (file-attributes (car files)))))
197 (if (and initial (not (equal initial current)))
198 (setq initial (current-time) files nil)
199 (setq initial current))
200 (setq files (cdr files))))
201 (format-time-string "%Y%m%d%H%M.%S" initial)))
202
188(defun dired-do-chxxx (attribute-name program op-symbol arg) 203(defun dired-do-chxxx (attribute-name program op-symbol arg)
189 ;; Change file attributes (mode, group, owner, timestamp) of marked files and 204 ;; Change file attributes (mode, group, owner, timestamp) of marked files and
190 ;; refresh their file lines. 205 ;; refresh their file lines.
@@ -196,7 +211,8 @@ List has a form of (file-name full-file-name (attribute-list))"
196 (new-attribute 211 (new-attribute
197 (dired-mark-read-string 212 (dired-mark-read-string
198 (concat "Change " attribute-name " of %s to: ") 213 (concat "Change " attribute-name " of %s to: ")
199 nil op-symbol arg files)) 214 (if (eq op-symbol 'touch) (dired-touch-initial files))
215 op-symbol arg files))
200 (operation (concat program " " new-attribute)) 216 (operation (concat program " " new-attribute))
201 failures) 217 failures)
202 (setq failures 218 (setq failures
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 5a7cd1093c4..54efd14b358 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
1;;; find-func.el --- find the definition of the Emacs Lisp function near point 1;;; find-func.el --- find the definition of the Emacs Lisp function near point
2 2
3;; Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1999, 2001, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp> 5;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
6;; Maintainer: petersen@kurims.kyoto-u.ac.jp 6;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@@ -128,6 +128,40 @@ See the functions `find-function' and `find-variable'."
128 (append (find-library-suffixes) '(""))) 128 (append (find-library-suffixes) '("")))
129 (error "Can't find library %s" library))) 129 (error "Can't find library %s" library)))
130 130
131(defvar find-function-C-source-directory
132 (let ((dir (expand-file-name "src" source-directory)))
133 (when (and (file-directory-p dir) (file-readable-p dir))
134 dir))
135 "Directory where the C source files of Emacs can be found.
136If nil, do not try to find the source code of functions and variables
137defined in C.")
138
139(defun find-function-C-source (fun-or-var file variable-p)
140 "Find the source location where SUBR-OR-VAR is defined in FILE.
141VARIABLE-P should be non-nil for a variable or nil for a subroutine."
142 (unless find-function-C-source-directory
143 (setq find-function-C-source-directory
144 (read-directory-name "Emacs C source dir: " nil nil t)))
145 (setq file (expand-file-name file find-function-C-source-directory))
146 (unless (file-readable-p file)
147 (error "The C source file %s is not available"
148 (file-name-nondirectory file)))
149 (unless variable-p
150 (setq fun-or-var (indirect-function fun-or-var)))
151 (with-current-buffer (find-file-noselect file)
152 (goto-char (point-min))
153 (unless (re-search-forward
154 (if variable-p
155 (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
156 (regexp-quote (symbol-name fun-or-var))
157 "\"")
158 (concat "DEFUN[ \t\n]*([ \t\n]*\""
159 (regexp-quote (subr-name fun-or-var))
160 "\""))
161 nil t)
162 (error "Can't find source for %s" fun-or-var))
163 (cons (current-buffer) (match-beginning 0))))
164
131;;;###autoload 165;;;###autoload
132(defun find-library (library) 166(defun find-library (library)
133 "Find the elisp source of LIBRARY." 167 "Find the elisp source of LIBRARY."
@@ -149,9 +183,10 @@ If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
149 (error "Don't know where `%s' is defined" symbol)) 183 (error "Don't know where `%s' is defined" symbol))
150 ;; Some functions are defined as part of the construct 184 ;; Some functions are defined as part of the construct
151 ;; that defines something else. 185 ;; that defines something else.
152 (while (get symbol 'definition-name) 186 (while (and (symbolp symbol) (get symbol 'definition-name))
153 (setq symbol (get symbol 'definition-name))) 187 (setq symbol (get symbol 'definition-name)))
154 (save-match-data 188 (if (string-match "\\`src/\\(.*\\.c\\)\\'" library)
189 (find-function-C-source symbol (match-string 1 library) variable-p)
155 (if (string-match "\\.el\\(c\\)\\'" library) 190 (if (string-match "\\.el\\(c\\)\\'" library)
156 (setq library (substring library 0 (match-beginning 1)))) 191 (setq library (substring library 0 (match-beginning 1))))
157 (let* ((filename (find-library-name library))) 192 (let* ((filename (find-library-name library)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index e1ed508b865..8fe839b474d 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -175,6 +175,8 @@ open-parenthesis, and point ends up at the beginning of the line.
175If variable `beginning-of-defun-function' is non-nil, its value 175If variable `beginning-of-defun-function' is non-nil, its value
176is called as a function to find the defun's beginning." 176is called as a function to find the defun's beginning."
177 (interactive "p") 177 (interactive "p")
178 (and (eq this-command 'beginning-of-defun)
179 (or (eq last-command 'beginning-of-defun) (push-mark)))
178 (and (beginning-of-defun-raw arg) 180 (and (beginning-of-defun-raw arg)
179 (progn (beginning-of-line) t))) 181 (progn (beginning-of-line) t)))
180 182
@@ -223,6 +225,8 @@ matches the open-parenthesis that starts a defun; see function
223If variable `end-of-defun-function' is non-nil, its value 225If variable `end-of-defun-function' is non-nil, its value
224is called as a function to find the defun's end." 226is called as a function to find the defun's end."
225 (interactive "p") 227 (interactive "p")
228 (and (eq this-command 'end-of-defun)
229 (or (eq last-command 'end-of-defun) (push-mark)))
226 (if (or (null arg) (= arg 0)) (setq arg 1)) 230 (if (or (null arg) (= arg 0)) (setq arg 1))
227 (if end-of-defun-function 231 (if end-of-defun-function
228 (if (> arg 0) 232 (if (> arg 0)
@@ -302,29 +306,48 @@ Optional ARG is ignored."
302 (end-of-defun) 306 (end-of-defun)
303 (narrow-to-region beg (point))))) 307 (narrow-to-region beg (point)))))
304 308
305(defun insert-parentheses (arg) 309(defun insert-pair (arg &optional open close)
306 "Enclose following ARG sexps in parentheses. Leave point after open-paren. 310 "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
311Leave point after the first character.
307A negative ARG encloses the preceding ARG sexps instead. 312A negative ARG encloses the preceding ARG sexps instead.
308No argument is equivalent to zero: just insert `()' and leave point between. 313No argument is equivalent to zero: just insert characters
314and leave point between.
309If `parens-require-spaces' is non-nil, this command also inserts a space 315If `parens-require-spaces' is non-nil, this command also inserts a space
310before and after, depending on the surrounding characters." 316before and after, depending on the surrounding characters.
317If region is active, insert enclosing characters at region boundaries."
311 (interactive "P") 318 (interactive "P")
312 (if arg (setq arg (prefix-numeric-value arg)) 319 (if arg (setq arg (prefix-numeric-value arg))
313 (setq arg 0)) 320 (setq arg 0))
314 (cond ((> arg 0) (skip-chars-forward " \t")) 321 (or open (setq open ?\())
315 ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) 322 (or close (setq close ?\)))
316 (and parens-require-spaces 323 (if (and transient-mark-mode mark-active)
317 (not (bobp)) 324 (progn
318 (memq (char-syntax (preceding-char)) '(?w ?_ ?\) )) 325 (save-excursion (goto-char (region-end)) (insert close))
319 (insert " ")) 326 (save-excursion (goto-char (region-beginning)) (insert open)))
320 (insert ?\() 327 (cond ((> arg 0) (skip-chars-forward " \t"))
321 (save-excursion 328 ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
322 (or (eq arg 0) (forward-sexp arg))
323 (insert ?\))
324 (and parens-require-spaces 329 (and parens-require-spaces
325 (not (eobp)) 330 (not (bobp))
326 (memq (char-syntax (following-char)) '(?w ?_ ?\( )) 331 (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
327 (insert " ")))) 332 (insert " "))
333 (insert open)
334 (save-excursion
335 (or (eq arg 0) (forward-sexp arg))
336 (insert close)
337 (and parens-require-spaces
338 (not (eobp))
339 (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
340 (insert " ")))))
341
342(defun insert-parentheses (arg)
343 "Enclose following ARG sexps in parentheses. Leave point after open-paren.
344A negative ARG encloses the preceding ARG sexps instead.
345No argument is equivalent to zero: just insert `()' and leave point between.
346If `parens-require-spaces' is non-nil, this command also inserts a space
347before and after, depending on the surrounding characters.
348If region is active, insert enclosing characters at region boundaries."
349 (interactive "P")
350 (insert-pair arg ?\( ?\)))
328 351
329(defun move-past-close-and-reindent () 352(defun move-past-close-and-reindent ()
330 "Move past next `)', delete indentation before it, then indent after it." 353 "Move past next `)', delete indentation before it, then indent after it."
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 24f95ec21ea..c248dbbdcf2 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,6 @@
1;;; cua-base.el --- emulate CUA key bindings 1;;; cua-base.el --- emulate CUA key bindings
2 2
3;; Copyright (C) 1997,98,99,200,01,02,03 Free Software Foundation, Inc. 3;; Copyright (C) 1997,98,99,200,01,02,03,04 Free Software Foundation, Inc.
4 4
5;; Author: Kim F. Storm <storm@cua.dk> 5;; Author: Kim F. Storm <storm@cua.dk>
6;; Keywords: keyboard emulation convenience cua 6;; Keywords: keyboard emulation convenience cua
@@ -413,29 +413,101 @@ Can be toggled by [M-p] while the rectangle is active,"
413 "red") 413 "red")
414 "Normal (non-overwrite) cursor color. 414 "Normal (non-overwrite) cursor color.
415Also used to indicate that rectangle padding is not in effect. 415Also used to indicate that rectangle padding is not in effect.
416Default is to load cursor color from initial or default frame parameters." 416Default is to load cursor color from initial or default frame parameters.
417
418If the value is a COLOR name, then only the `cursor-color' attribute will be
419affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
420then only the `cursor-type' property will be affected. If the value is
421a cons (TYPE . COLOR), then both properties are affected."
417 :initialize 'custom-initialize-default 422 :initialize 'custom-initialize-default
418 :type 'color 423 :type '(choice
424 (color :tag "Color")
425 (choice :tag "Type"
426 (const :tag "Filled box" box)
427 (const :tag "Vertical bar" bar)
428 (const :tag "Horisontal bar" hbar)
429 (const :tag "Hollow box" hollow))
430 (cons :tag "Color and Type"
431 (choice :tag "Type"
432 (const :tag "Filled box" box)
433 (const :tag "Vertical bar" bar)
434 (const :tag "Horisontal bar" hbar)
435 (const :tag "Hollow box" hollow))
436 (color :tag "Color")))
419 :group 'cua) 437 :group 'cua)
420 438
421(defcustom cua-read-only-cursor-color "darkgreen" 439(defcustom cua-read-only-cursor-color "darkgreen"
422 "*Cursor color used in read-only buffers, if non-nil. 440 "*Cursor color used in read-only buffers, if non-nil.
423Only used when `cua-enable-cursor-indications' is non-nil." 441Only used when `cua-enable-cursor-indications' is non-nil.
424 :type 'color 442
443If the value is a COLOR name, then only the `cursor-color' attribute will be
444affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
445then only the `cursor-type' property will be affected. If the value is
446a cons (TYPE . COLOR), then both properties are affected."
447 :type '(choice
448 (color :tag "Color")
449 (choice :tag "Type"
450 (const :tag "Filled box" box)
451 (const :tag "Vertical bar" bar)
452 (const :tag "Horisontal bar" hbar)
453 (const :tag "Hollow box" hollow))
454 (cons :tag "Color and Type"
455 (choice :tag "Type"
456 (const :tag "Filled box" box)
457 (const :tag "Vertical bar" bar)
458 (const :tag "Horisontal bar" hbar)
459 (const :tag "Hollow box" hollow))
460 (color :tag "Color")))
425 :group 'cua) 461 :group 'cua)
426 462
427(defcustom cua-overwrite-cursor-color "yellow" 463(defcustom cua-overwrite-cursor-color "yellow"
428 "*Cursor color used when overwrite mode is set, if non-nil. 464 "*Cursor color used when overwrite mode is set, if non-nil.
429Also used to indicate that rectangle padding is in effect. 465Also used to indicate that rectangle padding is in effect.
430Only used when `cua-enable-cursor-indications' is non-nil." 466Only used when `cua-enable-cursor-indications' is non-nil.
431 :type 'color 467
468If the value is a COLOR name, then only the `cursor-color' attribute will be
469affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
470then only the `cursor-type' property will be affected. If the value is
471a cons (TYPE . COLOR), then both properties are affected."
472 :type '(choice
473 (color :tag "Color")
474 (choice :tag "Type"
475 (const :tag "Filled box" box)
476 (const :tag "Vertical bar" bar)
477 (const :tag "Horisontal bar" hbar)
478 (const :tag "Hollow box" hollow))
479 (cons :tag "Color and Type"
480 (choice :tag "Type"
481 (const :tag "Filled box" box)
482 (const :tag "Vertical bar" bar)
483 (const :tag "Horisontal bar" hbar)
484 (const :tag "Hollow box" hollow))
485 (color :tag "Color")))
432 :group 'cua) 486 :group 'cua)
433 487
434(defcustom cua-global-mark-cursor-color "cyan" 488(defcustom cua-global-mark-cursor-color "cyan"
435 "*Indication for active global mark. 489 "*Indication for active global mark.
436Will change cursor color to specified color if string. 490Will change cursor color to specified color if string.
437Only used when `cua-enable-cursor-indications' is non-nil." 491Only used when `cua-enable-cursor-indications' is non-nil.
438 :type 'color 492
493If the value is a COLOR name, then only the `cursor-color' attribute will be
494affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
495then only the `cursor-type' property will be affected. If the value is
496a cons (TYPE . COLOR), then both properties are affected."
497 :type '(choice
498 (color :tag "Color")
499 (choice :tag "Type"
500 (const :tag "Filled box" box)
501 (const :tag "Vertical bar" bar)
502 (const :tag "Horisontal bar" hbar)
503 (const :tag "Hollow box" hollow))
504 (cons :tag "Color and Type"
505 (choice :tag "Type"
506 (const :tag "Filled box" box)
507 (const :tag "Vertical bar" bar)
508 (const :tag "Horisontal bar" hbar)
509 (const :tag "Hollow box" hollow))
510 (color :tag "Color")))
439 :group 'cua) 511 :group 'cua)
440 512
441 513
@@ -893,7 +965,7 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
893 forward-word backward-word 965 forward-word backward-word
894 end-of-line beginning-of-line 966 end-of-line beginning-of-line
895 end-of-buffer beginning-of-buffer 967 end-of-buffer beginning-of-buffer
896 scroll-up scroll-down 968 scroll-up scroll-down cua-scroll-up cua-scroll-down
897 forward-sentence backward-sentence 969 forward-sentence backward-sentence
898 forward-paragraph backward-paragraph) 970 forward-paragraph backward-paragraph)
899 "List of standard movement commands. 971 "List of standard movement commands.
@@ -903,26 +975,72 @@ Extra commands should be added to `cua-movement-commands'")
903 "User may add additional movement commands to this list.") 975 "User may add additional movement commands to this list.")
904 976
905 977
978;;; Scrolling commands which does not signal errors at top/bottom
979;;; of buffer at first key-press (instead moves to top/bottom
980;;; of buffer).
981
982(defun cua-scroll-up (&optional arg)
983 "Scroll text of current window upward ARG lines; or near full screen if no ARG.
984If window cannot be scrolled further, move cursor to bottom line instead.
985A near full screen is `next-screen-context-lines' less than a full screen.
986Negative ARG means scroll downward.
987If ARG is the atom `-', scroll downward by nearly full screen."
988 (interactive "P")
989 (cond
990 ((eq arg '-) (cua-scroll-down nil))
991 ((< (prefix-numeric-value arg) 0)
992 (cua-scroll-down (- (prefix-numeric-value arg))))
993 ((eobp)
994 (scroll-up arg)) ; signal error
995 (t
996 (condition-case nil
997 (scroll-up arg)
998 (end-of-buffer (goto-char (point-max)))))))
999
1000(defun cua-scroll-down (&optional arg)
1001 "Scroll text of current window downward ARG lines; or near full screen if no ARG.
1002If window cannot be scrolled further, move cursor to top line instead.
1003A near full screen is `next-screen-context-lines' less than a full screen.
1004Negative ARG means scroll upward.
1005If ARG is the atom `-', scroll upward by nearly full screen."
1006 (interactive "P")
1007 (cond
1008 ((eq arg '-) (cua-scroll-up nil))
1009 ((< (prefix-numeric-value arg) 0)
1010 (cua-scroll-up (- (prefix-numeric-value arg))))
1011 ((bobp)
1012 (scroll-down arg)) ; signal error
1013 (t
1014 (condition-case nil
1015 (scroll-down arg)
1016 (beginning-of-buffer (goto-char (point-min)))))))
1017
906;;; Cursor indications 1018;;; Cursor indications
907 1019
908(defun cua--update-indications () 1020(defun cua--update-indications ()
909 (let ((cursor 1021 (let* ((cursor
910 (cond 1022 (cond
911 ((and cua--global-mark-active 1023 ((and cua--global-mark-active
912 (stringp cua-global-mark-cursor-color)) 1024 cua-global-mark-cursor-color)
913 cua-global-mark-cursor-color) 1025 cua-global-mark-cursor-color)
914 ((and buffer-read-only 1026 ((and buffer-read-only
915 (stringp cua-read-only-cursor-color)) 1027 cua-read-only-cursor-color)
916 cua-read-only-cursor-color) 1028 cua-read-only-cursor-color)
917 ((and (stringp cua-overwrite-cursor-color) 1029 ((and cua-overwrite-cursor-color
918 (or overwrite-mode 1030 (or overwrite-mode
919 (and cua--rectangle (cua--rectangle-padding)))) 1031 (and cua--rectangle (cua--rectangle-padding))))
920 cua-overwrite-cursor-color) 1032 cua-overwrite-cursor-color)
921 (t cua-normal-cursor-color)))) 1033 (t cua-normal-cursor-color)))
922 (if (and cursor 1034 (color (if (consp cursor) (cdr cursor) cursor))
923 (not (equal cursor (frame-parameter nil 'cursor-color)))) 1035 (type (if (consp cursor) (car cursor) cursor)))
924 (set-cursor-color cursor)) 1036 (if (and color
925 cursor)) 1037 (stringp color)
1038 (not (equal color (frame-parameter nil 'cursor-color))))
1039 (set-cursor-color color))
1040 (if (and type
1041 (symbolp type)
1042 (not (eq type (frame-parameter nil 'cursor-type))))
1043 (setq default-cursor-type type))))
926 1044
927 1045
928;;; Pre-command hook 1046;;; Pre-command hook
@@ -1108,6 +1226,10 @@ Extra commands should be added to `cua-movement-commands'")
1108 (define-key cua-global-keymap [remap undo] 'cua-undo) 1226 (define-key cua-global-keymap [remap undo] 'cua-undo)
1109 (define-key cua-global-keymap [remap advertised-undo] 'cua-undo) 1227 (define-key cua-global-keymap [remap advertised-undo] 'cua-undo)
1110 1228
1229 ;; scrolling
1230 (define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up)
1231 (define-key cua-global-keymap [remap scroll-down] 'cua-scroll-down)
1232
1111 (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region) 1233 (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region)
1112 (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill) 1234 (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill)
1113 (define-key cua--cua-keys-keymap [(control z)] 'undo) 1235 (define-key cua--cua-keys-keymap [(control z)] 'undo)
@@ -1189,7 +1311,9 @@ paste (in addition to the normal emacs bindings)."
1189 (add-hook 'post-command-hook 'cua--post-command-handler) 1311 (add-hook 'post-command-hook 'cua--post-command-handler)
1190 (if (and cua-enable-modeline-indications (not (assoc 'cua-mode minor-mode-alist))) 1312 (if (and cua-enable-modeline-indications (not (assoc 'cua-mode minor-mode-alist)))
1191 (setq minor-mode-alist (cons '(cua-mode cua--status-string) minor-mode-alist))) 1313 (setq minor-mode-alist (cons '(cua-mode cua--status-string) minor-mode-alist)))
1192 ) 1314 (if cua-enable-cursor-indications
1315 (cua--update-indications)))
1316
1193 (remove-hook 'pre-command-hook 'cua--pre-command-handler) 1317 (remove-hook 'pre-command-hook 'cua--pre-command-handler)
1194 (remove-hook 'post-command-hook 'cua--post-command-handler)) 1318 (remove-hook 'post-command-hook 'cua--post-command-handler))
1195 1319
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index fefd7001029..965fe63bced 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,6 +1,6 @@
1;;; cua-rect.el --- CUA unified rectangle support 1;;; cua-rect.el --- CUA unified rectangle support
2 2
3;; Copyright (C) 1997-2002 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2002, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Kim F. Storm <storm@cua.dk> 5;; Author: Kim F. Storm <storm@cua.dk>
6;; Keywords: keyboard emulations convenience CUA 6;; Keywords: keyboard emulations convenience CUA
@@ -1057,19 +1057,30 @@ The numbers are formatted according to the FORMAT string."
1057 (insert (format fmt first)) 1057 (insert (format fmt first))
1058 (setq first (+ first incr))))) 1058 (setq first (+ first incr)))))
1059 1059
1060(defmacro cua--convert-rectangle-as (command)
1061 `(cua--rectangle-operation 'clear nil nil nil
1062 '(lambda (s e l r)
1063 (,command s e))))
1064
1060(defun cua-upcase-rectangle () 1065(defun cua-upcase-rectangle ()
1061 "Convert the rectangle to upper case." 1066 "Convert the rectangle to upper case."
1062 (interactive) 1067 (interactive)
1063 (cua--rectangle-operation 'clear nil nil nil 1068 (cua--convert-rectangle-as upcase-region))
1064 '(lambda (s e l r)
1065 (upcase-region s e))))
1066 1069
1067(defun cua-downcase-rectangle () 1070(defun cua-downcase-rectangle ()
1068 "Convert the rectangle to lower case." 1071 "Convert the rectangle to lower case."
1069 (interactive) 1072 (interactive)
1070 (cua--rectangle-operation 'clear nil nil nil 1073 (cua--convert-rectangle-as downcase-region))
1071 '(lambda (s e l r) 1074
1072 (downcase-region s e)))) 1075(defun cua-upcase-initials-rectangle ()
1076 "Convert the rectangle initials to upper case."
1077 (interactive)
1078 (cua--convert-rectangle-as upcase-initials-region))
1079
1080(defun cua-capitalize-rectangle ()
1081 "Convert the rectangle to proper case."
1082 (interactive)
1083 (cua--convert-rectangle-as capitalize-region))
1073 1084
1074 1085
1075;;; Replace/rearrange text in current rectangle 1086;;; Replace/rearrange text in current rectangle
diff --git a/lisp/files.el b/lisp/files.el
index 6a406b6fbf0..ca24de2862d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4423,7 +4423,7 @@ be a predicate function such as `yes-or-no-p'."
4423 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p) 4423 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
4424 (const :tag "Ask with y-or-n-p" y-or-n-p) 4424 (const :tag "Ask with y-or-n-p" y-or-n-p)
4425 (const :tag "Don't confirm" nil)) 4425 (const :tag "Don't confirm" nil))
4426 :group 'emacs 4426 :group 'convenience
4427 :version "21.1") 4427 :version "21.1")
4428 4428
4429(defun save-buffers-kill-emacs (&optional arg) 4429(defun save-buffers-kill-emacs (&optional arg)
diff --git a/lisp/follow.el b/lisp/follow.el
index 0ae6e175386..06857fc49e9 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1561,7 +1561,7 @@ non-first windows in Follow Mode."
1561 (or follow-internal-force-redisplay 1561 (or follow-internal-force-redisplay
1562 (progn 1562 (progn
1563 (if (eq dest (point-max)) 1563 (if (eq dest (point-max))
1564 ;; We're at the end, we have be be careful since 1564 ;; We're at the end, we have to be careful since
1565 ;; the display can be aligned while `dest' can 1565 ;; the display can be aligned while `dest' can
1566 ;; be visible in several windows. 1566 ;; be visible in several windows.
1567 (cond 1567 (cond
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6a71a544638..4e57ea6d74e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -216,27 +216,13 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
216 (intern (upcase name)))))) 216 (intern (upcase name))))))
217 arglist))) 217 arglist)))
218 218
219(defvar help-C-source-directory
220 (let ((dir (expand-file-name "src" source-directory)))
221 (when (and (file-directory-p dir) (file-readable-p dir))
222 dir))
223 "Directory where the C source files of Emacs can be found.
224If nil, do not try to find the source code of functions and variables
225defined in C.")
226
227(defun help-subr-name (subr)
228 (let ((name (prin1-to-string subr)))
229 (if (string-match "\\`#<subr \\(.*\\)>\\'" name)
230 (match-string 1 name)
231 (error "Unexpected subroutine print name: %s" name))))
232
233(defun help-C-file-name (subr-or-var kind) 219(defun help-C-file-name (subr-or-var kind)
234 "Return the name of the C file where SUBR-OR-VAR is defined. 220 "Return the name of the C file where SUBR-OR-VAR is defined.
235KIND should be `var' for a variable or `subr' for a subroutine." 221KIND should be `var' for a variable or `subr' for a subroutine."
236 (let ((docbuf (get-buffer-create " *DOC*")) 222 (let ((docbuf (get-buffer-create " *DOC*"))
237 (name (if (eq 'var kind) 223 (name (if (eq 'var kind)
238 (concat "V" (symbol-name subr-or-var)) 224 (concat "V" (symbol-name subr-or-var))
239 (concat "F" (help-subr-name subr-or-var))))) 225 (concat "F" (subr-name subr-or-var)))))
240 (with-current-buffer docbuf 226 (with-current-buffer docbuf
241 (goto-char (point-min)) 227 (goto-char (point-min))
242 (if (eobp) 228 (if (eobp)
@@ -246,31 +232,11 @@ KIND should be `var' for a variable or `subr' for a subroutine."
246 (re-search-backward "S\\(.*\\)") 232 (re-search-backward "S\\(.*\\)")
247 (let ((file (match-string 1))) 233 (let ((file (match-string 1)))
248 (if (string-match "\\.\\(o\\|obj\\)\\'" file) 234 (if (string-match "\\.\\(o\\|obj\\)\\'" file)
249 (replace-match ".c" t t file) 235 (setq file (replace-match ".c" t t file)))
236 (if (string-match "\\.c\\'" file)
237 (concat "src/" file)
250 file))))) 238 file)))))
251 239
252(defun help-find-C-source (fun-or-var file kind)
253 "Find the source location where SUBR-OR-VAR is defined in FILE.
254KIND should be `var' for a variable or `subr' for a subroutine."
255 (setq file (expand-file-name file help-C-source-directory))
256 (unless (file-readable-p file)
257 (error "The C source file %s is not available"
258 (file-name-nondirectory file)))
259 (if (eq 'fun kind)
260 (setq fun-or-var (indirect-function fun-or-var)))
261 (with-current-buffer (find-file-noselect file)
262 (goto-char (point-min))
263 (unless (re-search-forward
264 (if (eq 'fun kind)
265 (concat "DEFUN[ \t\n]*([ \t\n]*\""
266 (regexp-quote (help-subr-name fun-or-var))
267 "\"")
268 (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
269 (regexp-quote (symbol-name fun-or-var))))
270 nil t)
271 (error "Can't find source for %s" fun))
272 (cons (current-buffer) (match-beginning 0))))
273
274;;;###autoload 240;;;###autoload
275(defun describe-function-1 (function) 241(defun describe-function-1 (function)
276 (let* ((def (if (symbolp function) 242 (let* ((def (if (symbolp function)
@@ -336,14 +302,16 @@ KIND should be `var' for a variable or `subr' for a subroutine."
336 (when (re-search-backward 302 (when (re-search-backward
337 "^;;; Generated autoloads from \\(.*\\)" nil t) 303 "^;;; Generated autoloads from \\(.*\\)" nil t)
338 (setq file-name (match-string 1))))))) 304 (setq file-name (match-string 1)))))))
339 (when (and (null file-name) (subrp def) help-C-source-directory) 305 (when (and (null file-name) (subrp def))
340 ;; Find the C source file name. 306 ;; Find the C source file name.
341 (setq file-name (concat "src/" (help-C-file-name def 'subr)))) 307 (setq file-name (if (get-buffer " *DOC*")
308 (help-C-file-name def 'subr)
309 'C-source)))
342 (when file-name 310 (when file-name
343 (princ " in `") 311 (princ " in `")
344 ;; We used to add .el to the file name, 312 ;; We used to add .el to the file name,
345 ;; but that's completely wrong when the user used load-file. 313 ;; but that's completely wrong when the user used load-file.
346 (princ file-name) 314 (princ (if (eq file-name 'C-source) "C source code" file-name))
347 (princ "'") 315 (princ "'")
348 ;; Make a hyperlink to the library. 316 ;; Make a hyperlink to the library.
349 (with-current-buffer standard-output 317 (with-current-buffer standard-output
@@ -576,13 +544,13 @@ it is displayed along with the global value."
576 (when (and (null file-name) 544 (when (and (null file-name)
577 (integerp (get variable 'variable-documentation))) 545 (integerp (get variable 'variable-documentation)))
578 ;; It's a variable not defined in Elisp but in C. 546 ;; It's a variable not defined in Elisp but in C.
579 (if help-C-source-directory 547 (setq file-name
580 (setq file-name 548 (if (get-buffer " *DOC*")
581 (concat "src/" (help-C-file-name variable 'var))) 549 (help-C-file-name variable 'var)
582 (princ "\n\nDefined in core C code."))) 550 'C-source)))
583 (when file-name 551 (when file-name
584 (princ "\n\nDefined in `") 552 (princ "\n\nDefined in `")
585 (princ file-name) 553 (princ (if (eq file-name 'C-source) "C source code" file-name))
586 (princ "'.") 554 (princ "'.")
587 (with-current-buffer standard-output 555 (with-current-buffer standard-output
588 (save-excursion 556 (save-excursion
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 4499f5c48cb..1f1b529c8ef 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -147,14 +147,13 @@ The format is (FUNCTION ARGS...).")
147 :supertype 'help-xref 147 :supertype 'help-xref
148 'help-function (lambda (fun file) 148 'help-function (lambda (fun file)
149 (require 'find-func) 149 (require 'find-func)
150 (when (eq file 'C-source)
151 (setq file
152 (help-C-file-name (indirect-function fun) 'fun)))
150 ;; Don't use find-function-noselect because it follows 153 ;; Don't use find-function-noselect because it follows
151 ;; aliases (which fails for built-in functions). 154 ;; aliases (which fails for built-in functions).
152 (let ((location 155 (let ((location
153 (cond 156 (find-function-search-for-symbol fun nil file)))
154 ((bufferp file) (cons file fun))
155 ((string-match "\\`src/\\(.*\\.c\\)" file)
156 (help-find-C-source fun (match-string 1 file) 'fun))
157 (t (find-function-search-for-symbol fun nil file)))))
158 (pop-to-buffer (car location)) 157 (pop-to-buffer (car location))
159 (goto-char (cdr location)))) 158 (goto-char (cdr location))))
160 'help-echo (purecopy "mouse-2, RET: find function's definition")) 159 'help-echo (purecopy "mouse-2, RET: find function's definition"))
@@ -162,11 +161,9 @@ The format is (FUNCTION ARGS...).")
162(define-button-type 'help-variable-def 161(define-button-type 'help-variable-def
163 :supertype 'help-xref 162 :supertype 'help-xref
164 'help-function (lambda (var &optional file) 163 'help-function (lambda (var &optional file)
165 (let ((location 164 (when (eq file 'C-source)
166 (cond 165 (setq file (help-C-file-name var 'var)))
167 ((string-match "\\`src/\\(.*\\.c\\)" file) 166 (let ((location (find-variable-noselect var file)))
168 (help-find-C-source var (match-string 1 file) 'var))
169 (t (find-variable-noselect var file)))))
170 (pop-to-buffer (car location)) 167 (pop-to-buffer (car location))
171 (goto-char (cdr location)))) 168 (goto-char (cdr location))))
172 'help-echo (purecopy"mouse-2, RET: find variable's definition")) 169 'help-echo (purecopy"mouse-2, RET: find variable's definition"))
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 8e09f326019..644ee3d6c20 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -887,11 +887,21 @@ Return nil if there is nothing appropriate in the buffer near point."
887 ((string-equal item "gawk, versions of, information about, printing") 887 ((string-equal item "gawk, versions of, information about, printing")
888 "gawk")))))) 888 "gawk"))))))
889 889
890;; This misses some things which occur as node names but not in the
891;; index. Unfortunately it also picks up the wrong one of multiple
892;; entries for the same term in some cases. --fx
890(info-lookup-maybe-add-help 893(info-lookup-maybe-add-help
891 :mode 'cfengine-mode 894 :mode 'cfengine-mode
892 :regexp "[[:alnum:]_]+" 895 :regexp "[[:alnum:]_]+\\(:?()\\)?"
893 :doc-spec '(("(cfengine-Reference)Variable Index" nil 896 :doc-spec '(("(cfengine-Reference)Variable Index"
894 "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil))) 897 (lambda (item)
898 ;; Index entries may be like `IsPlain()'
899 (if (string-match "\\([[:alnum:]_]+\\)()" item)
900 (match-string 1 item)
901 item))
902 ;; This gets functions in evaluated classes. Other
903 ;; possible patterns don't seem to work too well.
904 "`" "(")))
895 905
896(provide 'info-look) 906(provide 'info-look)
897 907
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 759df5fd949..b1ce0a0255b 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1113,21 +1113,25 @@ the generated Quail package is saved."
1113 name title dicfile coding quailfile converter copyright 1113 name title dicfile coding quailfile converter copyright
1114 dicbuf) 1114 dicbuf)
1115 (while tail 1115 (while tail
1116 (when (or (string-match (nth 2 (car tail)) filename) 1116 (setq slot (car tail)
1117 ;; MS-DOS filesystem truncates file names to 8+3 1117 dicfile (nth 2 slot)
1118 ;; limits, so "cangjie-table.cns" becomes 1118 quailfile (nth 4 slot))
1119 ;; "cangjie-.cns", and the above string-match fails. 1119 (when (and (or (string-match dicfile filename)
1120 ;; Give DOS users a chance... 1120 ;; MS-DOS filesystem truncates file names to 8+3
1121 (and (fboundp 'msdos-long-file-names) 1121 ;; limits, so "cangjie-table.cns" becomes
1122 (not (msdos-long-file-names)) 1122 ;; "cangjie-.cns", and the above string-match
1123 (string-match (dos-8+3-filename (nth 2 (car tail))) 1123 ;; fails. Give DOS users a chance...
1124 filename))) 1124 (and (fboundp 'msdos-long-file-names)
1125 (setq slot (car tail) 1125 (not (msdos-long-file-names))
1126 name (car slot) 1126 (string-match (dos-8+3-filename dicfile) filename)))
1127 (if (file-newer-than-file-p
1128 filename (expand-file-name quailfile dirname))
1129 t
1130 (message "%s is up to date" quailfile)
1131 nil))
1132 (setq name (car slot)
1127 title (nth 1 slot) 1133 title (nth 1 slot)
1128 dicfile (nth 2 slot)
1129 coding (nth 3 slot) 1134 coding (nth 3 slot)
1130 quailfile (nth 4 slot)
1131 converter (nth 5 slot) 1135 converter (nth 5 slot)
1132 copyright (nth 6 slot)) 1136 copyright (nth 6 slot))
1133 (message "Converting %s to %s..." dicfile quailfile) 1137 (message "Converting %s to %s..." dicfile quailfile)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 91a2c34870d..76e72bfb632 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -294,7 +294,9 @@ Default value, nil, means edit the string instead."
294 (define-key map " " 'isearch-whitespace-chars) 294 (define-key map " " 'isearch-whitespace-chars)
295 (define-key map [?\S-\ ] 'isearch-whitespace-chars) 295 (define-key map [?\S-\ ] 'isearch-whitespace-chars)
296 296
297 (define-key map "\C-w" 'isearch-yank-word-or-char) 297 (define-key map "\C-b" 'isearch-del-char)
298 (define-key map "\C-f" 'isearch-yank-char)
299 (define-key map "\C-w" 'isearch-yank-word)
298 (define-key map "\C-y" 'isearch-yank-line) 300 (define-key map "\C-y" 'isearch-yank-line)
299 301
300 ;; Define keys for regexp chars * ? |. 302 ;; Define keys for regexp chars * ? |.
@@ -448,12 +450,15 @@ With a prefix argument, do an incremental regular expression search instead.
448As you type characters, they add to the search string and are found. 450As you type characters, they add to the search string and are found.
449The following non-printing keys are bound in `isearch-mode-map'. 451The following non-printing keys are bound in `isearch-mode-map'.
450 452
451Type \\[isearch-delete-char] to cancel characters from end of search string. 453Type \\[isearch-delete-char] to cancel last input item from end of search string.
454Type \\[isearch-del-char] to cancel last character from end of search string.
452Type \\[isearch-exit] to exit, leaving point at location found. 455Type \\[isearch-exit] to exit, leaving point at location found.
453Type LFD (C-j) to match end of line. 456Type LFD (C-j) to match end of line.
454Type \\[isearch-repeat-forward] to search again forward,\ 457Type \\[isearch-repeat-forward] to search again forward,\
455 \\[isearch-repeat-backward] to search again backward. 458 \\[isearch-repeat-backward] to search again backward.
456Type \\[isearch-yank-word-or-char] to yank word from buffer onto end of search\ 459Type \\[isearch-yank-char] to yank character from buffer onto end of search\
460 string and search for it.
461Type \\[isearch-yank-word] to yank word from buffer onto end of search\
457 string and search for it. 462 string and search for it.
458Type \\[isearch-yank-line] to yank rest of line onto end of search string\ 463Type \\[isearch-yank-line] to yank rest of line onto end of search string\
459 and search for it. 464 and search for it.
@@ -486,7 +491,7 @@ To use a different input method for searching, type
486you want to use. 491you want to use.
487 492
488The above keys, bound in `isearch-mode-map', are often controlled by 493The above keys, bound in `isearch-mode-map', are often controlled by
489 options; do M-x apropos on search-.* to find them. 494 options; do \\[apropos] on search-.* to find them.
490Other control and meta characters terminate the search 495Other control and meta characters terminate the search
491 and are then executed normally (depending on `search-exit-option'). 496 and are then executed normally (depending on `search-exit-option').
492Likewise for function keys and mouse button events. 497Likewise for function keys and mouse button events.
@@ -789,7 +794,7 @@ The following additional command keys are active while editing.
789\\[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring. 794\\[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring.
790\\[isearch-complete-edit] to complete the search string using the search ring. 795\\[isearch-complete-edit] to complete the search string using the search ring.
791\\<isearch-mode-map> 796\\<isearch-mode-map>
792If first char entered is \\[isearch-yank-word-or-char], then do word search instead." 797If first char entered is \\[isearch-yank-word], then do word search instead."
793 798
794 ;; This code is very hairy for several reasons, explained in the code. 799 ;; This code is very hairy for several reasons, explained in the code.
795 ;; Mainly, isearch-mode must be terminated while editing and then restarted. 800 ;; Mainly, isearch-mode must be terminated while editing and then restarted.
@@ -1053,6 +1058,16 @@ If no previous match was done, just beep."
1053 (isearch-pop-state)) 1058 (isearch-pop-state))
1054 (isearch-update)) 1059 (isearch-update))
1055 1060
1061(defun isearch-del-char ()
1062 "Discard last character and move point back.
1063If there is no previous character, just beep."
1064 (interactive)
1065 (if (equal isearch-string "")
1066 (ding)
1067 (setq isearch-string (substring isearch-string 0 -1)
1068 isearch-message (mapconcat 'isearch-text-char-description
1069 isearch-string "")))
1070 (isearch-search-and-update))
1056 1071
1057(defun isearch-yank-string (string) 1072(defun isearch-yank-string (string)
1058 "Pull STRING into search string." 1073 "Pull STRING into search string."
@@ -1114,7 +1129,7 @@ might return the position of the end of the line."
1114 (buffer-substring-no-properties (point) (funcall jumpform))))) 1129 (buffer-substring-no-properties (point) (funcall jumpform)))))
1115 1130
1116(defun isearch-yank-char () 1131(defun isearch-yank-char ()
1117 "Pull next letter from buffer into search string." 1132 "Pull next character from buffer into search string."
1118 (interactive) 1133 (interactive)
1119 (isearch-yank-internal (lambda () (forward-char 1) (point)))) 1134 (isearch-yank-internal (lambda () (forward-char 1) (point))))
1120 1135
@@ -1142,9 +1157,8 @@ might return the position of the end of the line."
1142(defun isearch-search-and-update () 1157(defun isearch-search-and-update ()
1143 ;; Do the search and update the display. 1158 ;; Do the search and update the display.
1144 (when (or isearch-success 1159 (when (or isearch-success
1145 ;; unsuccessful regexp search may become 1160 ;; Unsuccessful regexp search may become successful by
1146 ;; successful by addition of characters which 1161 ;; addition of characters which make isearch-string valid
1147 ;; make isearch-string valid
1148 isearch-regexp 1162 isearch-regexp
1149 ;; If the string was found but was completely invisible, 1163 ;; If the string was found but was completely invisible,
1150 ;; it might now be partly visible, so try again. 1164 ;; it might now be partly visible, so try again.
@@ -1471,7 +1485,9 @@ Isearch mode."
1471 (command-execute scroll-command) 1485 (command-execute scroll-command)
1472 (let ((ab-bel (isearch-string-out-of-window isearch-point))) 1486 (let ((ab-bel (isearch-string-out-of-window isearch-point)))
1473 (if ab-bel 1487 (if ab-bel
1474 (isearch-back-into-window (eq ab-bel 'above) isearch-point))) 1488 (isearch-back-into-window (eq ab-bel 'above) isearch-point)
1489 (or (eq (point) isearch-point)
1490 (goto-char isearch-point))))
1475 (isearch-update)) 1491 (isearch-update))
1476 (search-exit-option 1492 (search-exit-option
1477 (let (window) 1493 (let (window)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index e45d6926d70..17deeff4619 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -893,7 +893,7 @@ PROPS are additional properties."
893 '("--")) 893 '("--"))
894(define-key menu-bar-options-menu [cua-mode] 894(define-key menu-bar-options-menu [cua-mode]
895 (menu-bar-make-mm-toggle cua-mode 895 (menu-bar-make-mm-toggle cua-mode
896 "CUA-style cut and paste" 896 "C-x/C-c/C-v cut and paste (CUA)"
897 "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste")) 897 "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"))
898 898
899(define-key menu-bar-options-menu [case-fold-search] 899(define-key menu-bar-options-menu [case-fold-search]
diff --git a/lisp/mouse.el b/lisp/mouse.el
index faa10e842d3..76098f45f1a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -42,6 +42,12 @@
42 "*If non-nil, mouse yank commands yank at point instead of at click." 42 "*If non-nil, mouse yank commands yank at point instead of at click."
43 :type 'boolean 43 :type 'boolean
44 :group 'mouse) 44 :group 'mouse)
45
46(defcustom mouse-drag-copy-region t
47 "*If non-nil, mouse drag copies region to kill-ring."
48 :type 'boolean
49 :group 'mouse)
50
45 51
46;; Provide a mode-specific menu on a mouse button. 52;; Provide a mode-specific menu on a mouse button.
47 53
@@ -612,8 +618,9 @@ This should be bound to a mouse drag event."
612 ;; Don't set this-command to kill-region, so that a following 618 ;; Don't set this-command to kill-region, so that a following
613 ;; C-w will not double the text in the kill ring. 619 ;; C-w will not double the text in the kill ring.
614 ;; Ignore last-command so we don't append to a preceding kill. 620 ;; Ignore last-command so we don't append to a preceding kill.
615 (let (this-command last-command deactivate-mark) 621 (when mouse-drag-copy-region
616 (copy-region-as-kill (mark) (point))) 622 (let (this-command last-command deactivate-mark)
623 (copy-region-as-kill (mark) (point))))
617 (mouse-set-region-1))) 624 (mouse-set-region-1)))
618 625
619(defun mouse-set-region-1 () 626(defun mouse-set-region-1 ()
@@ -827,8 +834,9 @@ If the click is in the echo area, display the `*Messages*' buffer."
827 (push-mark region-commencement t t) 834 (push-mark region-commencement t t)
828 (goto-char region-termination) 835 (goto-char region-termination)
829 ;; Don't let copy-region-as-kill set deactivate-mark. 836 ;; Don't let copy-region-as-kill set deactivate-mark.
830 (let (deactivate-mark) 837 (when mouse-drag-copy-region
831 (copy-region-as-kill (point) (mark t))) 838 (let (deactivate-mark)
839 (copy-region-as-kill (point) (mark t))))
832 (let ((buffer (current-buffer))) 840 (let ((buffer (current-buffer)))
833 (mouse-show-mark) 841 (mouse-show-mark)
834 ;; mouse-show-mark can call read-event, 842 ;; mouse-show-mark can call read-event,
diff --git a/lisp/outline.el b/lisp/outline.el
index 59aeb233fdd..0f7d3b627b0 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -216,6 +216,9 @@ in the file it applies to."
216(defvar outline-mode-hook nil 216(defvar outline-mode-hook nil
217 "*This hook is run when outline mode starts.") 217 "*This hook is run when outline mode starts.")
218 218
219(defvar outline-blank-line nil
220 "*Non-nil means to leave unhidden blank line before heading.")
221
219;;;###autoload 222;;;###autoload
220(define-derived-mode outline-mode text-mode "Outline" 223(define-derived-mode outline-mode text-mode "Outline"
221 "Set major mode for editing outlines with selective display. 224 "Set major mode for editing outlines with selective display.
@@ -349,7 +352,7 @@ at the end of the buffer."
349 (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 352 (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
350 nil 'move) 353 nil 'move)
351 (goto-char (match-beginning 0))) 354 (goto-char (match-beginning 0)))
352 (if (and (bolp) (not (bobp))) 355 (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
353 (forward-char -1))) 356 (forward-char -1)))
354 357
355(defun outline-next-heading () 358(defun outline-next-heading ()
@@ -706,8 +709,8 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
706 "Hide the body directly following this heading." 709 "Hide the body directly following this heading."
707 (interactive) 710 (interactive)
708 (outline-back-to-heading) 711 (outline-back-to-heading)
709 (outline-end-of-heading)
710 (save-excursion 712 (save-excursion
713 (outline-end-of-heading)
711 (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) 714 (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
712 715
713(defun show-entry () 716(defun show-entry ()
@@ -770,9 +773,10 @@ Show the heading too, if it is currently invisible."
770(defun outline-show-heading () 773(defun outline-show-heading ()
771 "Show the current heading and move to its end." 774 "Show the current heading and move to its end."
772 (outline-flag-region (- (point) 775 (outline-flag-region (- (point)
773 (if (bobp) 0 776 (if (bobp) 0
774 (if (eq (char-before (1- (point))) ?\n) 777 (if (and outline-blank-line
775 2 1))) 778 (eq (char-before (1- (point))) ?\n))
779 2 1)))
776 (progn (outline-end-of-heading) (point)) 780 (progn (outline-end-of-heading) (point))
777 nil)) 781 nil))
778 782
@@ -841,9 +845,9 @@ Show the heading too, if it is currently invisible."
841 (progn 845 (progn
842 ;; Go to end of line before heading 846 ;; Go to end of line before heading
843 (forward-char -1) 847 (forward-char -1)
844 (if (bolp) 848 (if (and outline-blank-line (bolp))
845 ;; leave blank line before heading 849 ;; leave blank line before heading
846 (forward-char -1)))))) 850 (forward-char -1))))))
847 851
848(defun show-branches () 852(defun show-branches ()
849 "Show all subheadings of this heading, but not their bodies." 853 "Show all subheadings of this heading, but not their bodies."
@@ -884,6 +888,8 @@ Default is enough to cause the following heading to appear."
884With argument, move up ARG levels. 888With argument, move up ARG levels.
885If INVISIBLE-OK is non-nil, also consider invisible lines." 889If INVISIBLE-OK is non-nil, also consider invisible lines."
886 (interactive "p") 890 (interactive "p")
891 (and (eq this-command 'outline-up-heading)
892 (or (eq last-command 'outline-up-heading) (push-mark)))
887 (outline-back-to-heading invisible-ok) 893 (outline-back-to-heading invisible-ok)
888 (let ((start-level (funcall outline-level))) 894 (let ((start-level (funcall outline-level)))
889 (if (eq start-level 1) 895 (if (eq start-level 1)
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 62633fe2940..16064586ee9 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1,6 +1,6 @@
1;;; cfengine.el --- mode for editing Cfengine files 1;;; cfengine.el --- mode for editing Cfengine files
2 2
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Dave Love <fx@gnu.org> 5;; Author: Dave Love <fx@gnu.org>
6;; Keywords: languages 6;; Keywords: languages
@@ -102,7 +102,8 @@ This includes those for cfservd as well as cfagent."))
102(defun cfengine-beginning-of-defun () 102(defun cfengine-beginning-of-defun ()
103 "`beginning-of-defun' function for Cfengine mode. 103 "`beginning-of-defun' function for Cfengine mode.
104Treats actions as defuns." 104Treats actions as defuns."
105 (end-of-line) 105 (unless (<= (current-column) (current-indentation))
106 (end-of-line))
106 (if (re-search-backward "^[[:alpha:]]+: *$" nil t) 107 (if (re-search-backward "^[[:alpha:]]+: *$" nil t)
107 (beginning-of-line) 108 (beginning-of-line)
108 (goto-char (point-min))) 109 (goto-char (point-min)))
@@ -113,7 +114,7 @@ Treats actions as defuns."
113Treats actions as defuns." 114Treats actions as defuns."
114 (end-of-line) 115 (end-of-line)
115 (if (re-search-forward "^[[:alpha:]]+: *$" nil t) 116 (if (re-search-forward "^[[:alpha:]]+: *$" nil t)
116 (progn (forward-line -1) (end-of-line)) 117 (beginning-of-line)
117 (goto-char (point-max))) 118 (goto-char (point-max)))
118 t) 119 t)
119 120
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index d85bb79064f..4c6f88813c0 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -492,6 +492,7 @@ Faces `compilation-error-face', `compilation-warning-face',
492 492
493 493
494;; Used for compatibility with the old compile.el. 494;; Used for compatibility with the old compile.el.
495(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
495(defvar compilation-parsing-end (make-marker)) 496(defvar compilation-parsing-end (make-marker))
496(defvar compilation-parse-errors-function nil) 497(defvar compilation-parse-errors-function nil)
497(defvar compilation-error-list nil) 498(defvar compilation-error-list nil)
@@ -1473,17 +1474,19 @@ region and the first line of the next region."
1473 loc)) 1474 loc))
1474 1475
1475(defcustom compilation-context-lines 0 1476(defcustom compilation-context-lines 0
1476 "*Display this many lines of leading context before message." 1477 "*Display this many lines of leading context before message.
1477 :type 'integer 1478If nil, don't scroll the compilation output window."
1479 :type '(choice integer (const :tag "No window scrolling" nil))
1478 :group 'compilation 1480 :group 'compilation
1479 :version "21.4") 1481 :version "21.4")
1480 1482
1481(defsubst compilation-set-window (w mk) 1483(defsubst compilation-set-window (w mk)
1482 "Align the compilation output window W with marker MK near top." 1484 "Align the compilation output window W with marker MK near top."
1483 (set-window-start w (save-excursion 1485 (if (integerp compilation-context-lines)
1484 (goto-char mk) 1486 (set-window-start w (save-excursion
1485 (beginning-of-line (- 1 compilation-context-lines)) 1487 (goto-char mk)
1486 (point))) 1488 (beginning-of-line (- 1 compilation-context-lines))
1489 (point))))
1487 (set-window-point w mk)) 1490 (set-window-point w mk))
1488 1491
1489(defun compilation-goto-locus (msg mk end-mk) 1492(defun compilation-goto-locus (msg mk end-mk)
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 11553a1fdb6..aada9be16dc 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -850,14 +850,16 @@ line-number before indenting."
850 850
851(defsubst f90-get-present-comment-type () 851(defsubst f90-get-present-comment-type ()
852 "If point lies within a comment, return the string starting the comment. 852 "If point lies within a comment, return the string starting the comment.
853For example, \"!\" or \"!!\"." 853For example, \"!\" or \"!!\", followed by the appropriate amount of
854whitespace, if any."
855 ;; Include the whitespace for consistent auto-filling of comment blocks.
854 (save-excursion 856 (save-excursion
855 (when (f90-in-comment) 857 (when (f90-in-comment)
856 (beginning-of-line) 858 (beginning-of-line)
857 (re-search-forward "!+" (line-end-position)) 859 (re-search-forward "!+[ \t]*" (line-end-position))
858 (while (f90-in-string) 860 (while (f90-in-string)
859 (re-search-forward "!+" (line-end-position))) 861 (re-search-forward "!+[ \t]*" (line-end-position)))
860 (match-string 0)))) 862 (match-string-no-properties 0))))
861 863
862(defsubst f90-equal-symbols (a b) 864(defsubst f90-equal-symbols (a b)
863 "Compare strings A and B neglecting case and allowing for nil value." 865 "Compare strings A and B neglecting case and allowing for nil value."
@@ -1519,6 +1521,7 @@ is non-nil, call `f90-update-line' after inserting the continuation marker."
1519 (cond ((f90-in-string) 1521 (cond ((f90-in-string)
1520 (insert "&\n&")) 1522 (insert "&\n&"))
1521 ((f90-in-comment) 1523 ((f90-in-comment)
1524 (delete-horizontal-space 'backwards) ; remove trailing whitespace
1522 (insert "\n" (f90-get-present-comment-type))) 1525 (insert "\n" (f90-get-present-comment-type)))
1523 (t (insert "&") 1526 (t (insert "&")
1524 (or no-update (f90-update-line)) 1527 (or no-update (f90-update-line))
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index f23eabe6e9c..88d41650c07 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1700,8 +1700,7 @@ If ALL is nil, only match comments that start in column > 0."
1700 (while repeat 1700 (while repeat
1701 (setq repeat nil) 1701 (setq repeat nil)
1702 ;; Adapted from f90-find-breakpoint. 1702 ;; Adapted from f90-find-breakpoint.
1703 (re-search-backward fortran-break-delimiters-re 1703 (re-search-backward fortran-break-delimiters-re bol)
1704 (line-beginning-position))
1705 (if (not fortran-break-before-delimiters) 1704 (if (not fortran-break-before-delimiters)
1706 (if (looking-at fortran-no-break-re) 1705 (if (looking-at fortran-no-break-re)
1707 ;; Deal with cases such as "**" split over 1706 ;; Deal with cases such as "**" split over
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index a85cd2296ae..9eaba9027b8 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1141,6 +1141,14 @@ def _emacs_args (name): # get arglist of name for eldoc &c
1141print '_emacs_ok'")) 1141print '_emacs_ok'"))
1142 (unless noshow (pop-to-buffer (setq python-buffer "*Python*")))) 1142 (unless noshow (pop-to-buffer (setq python-buffer "*Python*"))))
1143 1143
1144(defun python-send-command (command)
1145 "Like `python-send-string' but resets `compilation-minor-mode'."
1146 (let ((end (marker-position (process-mark (python-proc)))))
1147 (compilation-forget-errors)
1148 (python-send-string command)
1149 (set-marker compilation-parsing-end end)
1150 (setq compilation-last-buffer (current-buffer))))
1151
1144(defun python-send-region (start end) 1152(defun python-send-region (start end)
1145 "Send the region to the inferior Python process." 1153 "Send the region to the inferior Python process."
1146 ;; The region is evaluated from a temporary file. This avoids 1154 ;; The region is evaluated from a temporary file. This avoids
@@ -1170,14 +1178,11 @@ print '_emacs_ok'"))
1170 (write-region start end f t 'nomsg) 1178 (write-region start end f t 'nomsg)
1171 (when python-buffer 1179 (when python-buffer
1172 (with-current-buffer python-buffer 1180 (with-current-buffer python-buffer
1173 (let ((end (marker-position (process-mark (python-proc))))) 1181 (set (make-local-variable 'python-orig-start) orig-start)
1174 (set (make-local-variable 'python-orig-start) orig-start) 1182 (let ((comint-input-filter-functions
1175 (set (make-local-variable 'compilation-error-list) nil) 1183 ;; Don't reset python-orig-start.
1176 (let ((comint-input-filter-functions 1184 (remq 'python-input-filter comint-input-filter-functions)))
1177 (delete 'python-input-filter comint-input-filter-functions))) 1185 (python-send-command command))))))
1178 (python-send-string command))
1179 (set-marker compilation-parsing-end end)
1180 (setq compilation-last-buffer (current-buffer)))))))
1181 1186
1182(defun python-send-string (string) 1187(defun python-send-string (string)
1183 "Evaluate STRING in inferior Python process." 1188 "Evaluate STRING in inferior Python process."
@@ -1242,25 +1247,17 @@ module-qualified names."
1242 (file-name-nondirectory file-name))) 1247 (file-name-nondirectory file-name)))
1243 (when python-buffer 1248 (when python-buffer
1244 (with-current-buffer python-buffer 1249 (with-current-buffer python-buffer
1245 (let ((end (marker-position (process-mark (python-proc))))) 1250 ;; Fixme: I'm not convinced by this logic from python-mode.el.
1246 (set (make-local-variable 'compilation-error-list) nil) 1251 (python-send-command
1247 ;; (set (make-local-variable 'compilation-old-error-list) nil) 1252 (if (string-match "\\.py\\'" file-name)
1248 (let ((comint-input-filter-functions 1253 ;; Fixme: make sure the directory is in the path list
1249 (delete 'python-input-filter comint-input-filter-functions))) 1254 (let ((module (file-name-sans-extension
1250 (set (make-local-variable 'python-orig-start) nil) 1255 (file-name-nondirectory file-name))))
1251 ;; Fixme: I'm not convinced by this logic from python-mode.el. 1256 (format "\
1252 (python-send-string
1253 (if (string-match "\\.py\\'" file-name)
1254 ;; Fixme: make sure the directory is in the path list
1255 (let ((module (file-name-sans-extension
1256 (file-name-nondirectory file-name))))
1257 (format "\
1258if globals().has_key(%S): reload(%s) 1257if globals().has_key(%S): reload(%s)
1259else: import %s 1258else: import %s
1260" module module module)) 1259" module module module))
1261 (format "execfile('%s')" file-name)))) 1260 (format "execfile('%s')" file-name))))))
1262 (set-marker compilation-parsing-end end)
1263 (setq compilation-last-buffer (current-buffer))))))
1264 1261
1265;; Fixme: Should this start a process if there isn't one? (Unlike cmuscheme.) 1262;; Fixme: Should this start a process if there isn't one? (Unlike cmuscheme.)
1266(defun python-proc () 1263(defun python-proc ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 1a9251599ce..420b5f226b0 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1,11 +1,12 @@
1;;; sql.el --- specialized comint.el for SQL interpreters 1;;; sql.el --- specialized comint.el for SQL interpreters
2 2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1998,99,2000,01,02,03,04 Free Software Foundation, Inc.
4 4
5;; Author: Alex Schroeder <alex@gnu.org> 5;; Author: Alex Schroeder <alex@gnu.org>
6;; Maintainer: Michael Mauger <mmaug@yahoo.com> 6;; Maintainer: Michael Mauger <mmaug@yahoo.com>
7;; Version: 1.8.0 7;; Version: 2.0.0
8;; Keywords: comm languages processes 8;; Keywords: comm languages processes
9;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
9;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode 10;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
10 11
11;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
@@ -101,7 +102,7 @@
101 102
102;; (const :tag "XyzDB" xyz) 103;; (const :tag "XyzDB" xyz)
103 104
104;; 2) Add an entry to the `sql-product-support' list. 105;; 2) Add an entry to the `sql-product-alist' list.
105 106
106;; (xyz 107;; (xyz
107;; :font-lock sql-mode-xyz-font-lock-keywords 108;; :font-lock sql-mode-xyz-font-lock-keywords
@@ -136,7 +137,7 @@
136;; using ANSI keywords. See sql-mode-oracle-font-lock-keywords for 137;; using ANSI keywords. See sql-mode-oracle-font-lock-keywords for
137;; a more complex example. 138;; a more complex example.
138 139
139;; (defvar sql-mode-xyz-font-lock-keywords sql-mode-ansi-font-lock-keywords 140;; (defvar sql-mode-xyz-font-lock-keywords nil
140;; "XyzDB SQL keywords used by font-lock.") 141;; "XyzDB SQL keywords used by font-lock.")
141 142
142;; 6) Add a product highlighting function. 143;; 6) Add a product highlighting function.
@@ -192,6 +193,7 @@
192 193
193;;; Thanks to all the people who helped me out: 194;;; Thanks to all the people who helped me out:
194 195
196;; Alex Schroeder <alex@gnu.org>
195;; Kai Blauberg <kai.blauberg@metla.fi> 197;; Kai Blauberg <kai.blauberg@metla.fi>
196;; <ibalaban@dalet.com> 198;; <ibalaban@dalet.com>
197;; Yair Friedman <yfriedma@JohnBryce.Co.Il> 199;; Yair Friedman <yfriedma@JohnBryce.Co.Il>
@@ -199,6 +201,7 @@
199;; nino <nino@inform.dk> 201;; nino <nino@inform.dk>
200;; Berend de Boer <berend@pobox.com> 202;; Berend de Boer <berend@pobox.com>
201;; Michael Mauger <mmaug@yahoo.com> 203;; Michael Mauger <mmaug@yahoo.com>
204;; Adam Jenkins <adam@thejenkins.org>
202 205
203 206
204 207
@@ -209,6 +212,8 @@
209(eval-when-compile 212(eval-when-compile
210 (require 'regexp-opt)) 213 (require 'regexp-opt))
211(require 'custom) 214(require 'custom)
215(eval-when-compile ;; needed in Emacs 19, 20
216 (setq max-specpdl-size 2000))
212 217
213;;; Allow customization 218;;; Allow customization
214 219
@@ -264,7 +269,7 @@ highlighted properly when you open them."
264(defvar sql-interactive-product nil 269(defvar sql-interactive-product nil
265 "Product under `sql-interactive-mode'.") 270 "Product under `sql-interactive-mode'.")
266 271
267(defvar sql-product-support 272(defvar sql-product-alist
268 '((ansi 273 '((ansi
269 :font-lock sql-mode-ansi-font-lock-keywords) 274 :font-lock sql-mode-ansi-font-lock-keywords)
270 (db2 275 (db2
@@ -319,9 +324,9 @@ highlighted properly when you open them."
319 :syntax-alist ((?$ . "w") (?# . "w"))) 324 :syntax-alist ((?$ . "w") (?# . "w")))
320 (postgres 325 (postgres
321 :font-lock sql-mode-postgres-font-lock-keywords 326 :font-lock sql-mode-postgres-font-lock-keywords
322 :sqli-login (database server) 327 :sqli-login (user database server)
323 :sqli-connect sql-connect-postgres 328 :sqli-connect sql-connect-postgres
324 :sqli-prompt-regexp "^.*> *" 329 :sqli-prompt-regexp "^.*[#>] *"
325 :sqli-prompt-length 5) 330 :sqli-prompt-length 5)
326 (solid 331 (solid
327 :font-lock sql-mode-solid-font-lock-keywords 332 :font-lock sql-mode-solid-font-lock-keywords
@@ -372,10 +377,12 @@ following:
372 database. Do product specific 377 database. Do product specific
373 configuration of comint in this function. 378 configuration of comint in this function.
374 379
375 :sqli-prompt-regexp a regular expression string that matches the 380 :sqli-prompt-regexp a regular expression string that matches
376 prompt issued by the product interpreter. 381 the prompt issued by the product
382 interpreter. (Not needed in 21.3+)
377 383
378 :sqli-prompt-length the length of the prompt on the line. 384 :sqli-prompt-length the length of the prompt on the line.(Not
385 needed in 21.3+)
379 386
380 :syntax-alist an alist of syntax table entries to enable 387 :syntax-alist an alist of syntax table entries to enable
381 special character treatment by font-lock and 388 special character treatment by font-lock and
@@ -412,14 +419,14 @@ buffer is shown using `display-buffer'."
412 419
413(defvar sql-imenu-generic-expression 420(defvar sql-imenu-generic-expression
414 ;; Items are in reverse order because they are rendered in reverse. 421 ;; Items are in reverse order because they are rendered in reverse.
415 '(("Rules/Defaults" "^\\s-*create\\s-+\\(rule\\|default\\)\\s-+\\(\\w+\\)" 2) 422 '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3)
416 ("Sequences" "^\\s-*create\\s-+sequence\\s-+\\(\\w+\\)" 1) 423 ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2)
417 ("Triggers" "^\\s-*\\(create\\s-+\\(or\\s-+replace\\s-+\\)?\\)?trigger\\s-+\\(\\w+\\)" 3) 424 ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2)
418 ("Functions" "^\\s-*\\(create\\s-+\\(or\\s-+replace\\s-+\\)?\\)?function\\s-+\\(\\w+\\)" 3) 425 ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3)
419 ("Procedures" "^\\s-*\\(create\\s-+\\(or\\s-+replace\\s-+\\)?\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4) 426 ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4)
420 ("Packages" "^\\s-*create\\s-+\\(or\\s-+replace\\s-+\\)?package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3) 427 ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
421 ("Indexes" "^\\s-*create\\s-+index\\s-+\\(\\w+\\)" 1) 428 ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2)
422 ("Tables/Views" "^\\s-*create\\s-+\\(\\(global\\s-+\\)?\\(temporary\\s-+\\)?table\\|view\\)\\s-+\\(\\w+\\)" 4)) 429 ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3))
423 "Define interesting points in the SQL buffer for `imenu'. 430 "Define interesting points in the SQL buffer for `imenu'.
424 431
425This is used to set `imenu-generic-expression' when SQL mode is 432This is used to set `imenu-generic-expression' when SQL mode is
@@ -686,6 +693,18 @@ Starts `sql-interactive-mode' after doing some setup."
686 693
687;;; Variables which do not need customization 694;;; Variables which do not need customization
688 695
696(defvar sql-xemacs-p
697 (string-match "XEmacs\\|Lucid" emacs-version)
698 "Is this a non-GNU Emacs?")
699
700(defvar sql-emacs19-p
701 (string-match "GNU Emacs 19" emacs-version)
702 "Is this a GNU Emacs 19?")
703
704(defvar sql-emacs20-p
705 (string-match "20" emacs-version)
706 "Is this a GNU Emacs 20?")
707
689(defvar sql-user-history nil 708(defvar sql-user-history nil
690 "History of usernames used.") 709 "History of usernames used.")
691 710
@@ -745,6 +764,7 @@ Based on `comint-mode-map'.")
745 (let ((map (make-sparse-keymap))) 764 (let ((map (make-sparse-keymap)))
746 (define-key map (kbd "C-c C-c") 'sql-send-paragraph) 765 (define-key map (kbd "C-c C-c") 'sql-send-paragraph)
747 (define-key map (kbd "C-c C-r") 'sql-send-region) 766 (define-key map (kbd "C-c C-r") 'sql-send-region)
767 (define-key map (kbd "C-c C-s") 'sql-send-string)
748 (define-key map (kbd "C-c C-b") 'sql-send-buffer) 768 (define-key map (kbd "C-c C-b") 'sql-send-buffer)
749 map) 769 map)
750 "Mode map used for `sql-mode'.") 770 "Mode map used for `sql-mode'.")
@@ -764,6 +784,7 @@ Based on `comint-mode-map'.")
764 (get-buffer-process sql-buffer))] 784 (get-buffer-process sql-buffer))]
765 ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer) 785 ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
766 (get-buffer-process sql-buffer))] 786 (get-buffer-process sql-buffer))]
787 ["Send String" sql-send-string t]
767 ["--" nil nil] 788 ["--" nil nil]
768 ["Start SQLi session" sql-product-interactive (sql-product-feature :sqli-connect)] 789 ["Start SQLi session" sql-product-interactive (sql-product-feature :sqli-connect)]
769 ["Show SQLi buffer" sql-show-sqli-buffer t] 790 ["Show SQLi buffer" sql-show-sqli-buffer t]
@@ -792,7 +813,7 @@ Based on `comint-mode-map'.")
792 ["Linter" sql-highlight-linter-keywords 813 ["Linter" sql-highlight-linter-keywords
793 :style radio 814 :style radio
794 :selected (eq sql-product 'linter)] 815 :selected (eq sql-product 'linter)]
795 ["Microsoft" sql-highlight-ms-keywords 816 ["MS SQLServer" sql-highlight-ms-keywords
796 :style radio 817 :style radio
797 :selected (eq sql-product 'ms)] 818 :selected (eq sql-product 'ms)]
798 ["MySQL" sql-highlight-mysql-keywords 819 ["MySQL" sql-highlight-mysql-keywords
@@ -828,24 +849,24 @@ Based on `comint-mode-map'.")
828 849
829(defvar sql-mode-abbrev-table nil 850(defvar sql-mode-abbrev-table nil
830 "Abbrev table used in `sql-mode' and `sql-interactive-mode'.") 851 "Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
831(if sql-mode-abbrev-table 852(unless sql-mode-abbrev-table
832 () 853 (define-abbrev-table 'sql-mode-abbrev-table nil)
833 (let ((nargs (cdr (subr-arity (symbol-function 'define-abbrev)))) 854 (mapcar
834 d-a)
835 ;; In Emacs 21.3+, provide SYSTEM-FLAG to define-abbrev. 855 ;; In Emacs 21.3+, provide SYSTEM-FLAG to define-abbrev.
836 (setq d-a 856 '(lambda (abbrev)
837 (if (>= nargs 6) 857 (let ((name (car abbrev))
838 '(lambda (name expansion) (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)) 858 (expansion (cdr abbrev)))
839 '(lambda (name expansion) (define-abbrev sql-mode-abbrev-table name expansion)))) 859 (condition-case nil
840 860 (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
841 (define-abbrev-table 'sql-mode-abbrev-table nil) 861 (error
842 (funcall d-a "ins" "insert") 862 (define-abbrev sql-mode-abbrev-table name expansion)))))
843 (funcall d-a "upd" "update") 863 '(("ins" "insert")
844 (funcall d-a "del" "delete") 864 ("upd" "update")
845 (funcall d-a "sel" "select") 865 ("del" "delete")
846 (funcall d-a "proc" "procedure") 866 ("sel" "select")
847 (funcall d-a "func" "function") 867 ("proc" "procedure")
848 (funcall d-a "cr" "create"))) 868 ("func" "function")
869 ("cr" "create"))))
849 870
850;; Syntax Table 871;; Syntax Table
851 872
@@ -855,7 +876,7 @@ Based on `comint-mode-map'.")
855 (modify-syntax-entry ?/ ". 14" table) 876 (modify-syntax-entry ?/ ". 14" table)
856 (modify-syntax-entry ?* ". 23" table) 877 (modify-syntax-entry ?* ". 23" table)
857 ;; double-dash starts comment 878 ;; double-dash starts comment
858 (if (string-match "XEmacs\\|Lucid" emacs-version) 879 (if sql-xemacs-p
859 (modify-syntax-entry ?- ". 56" table) 880 (modify-syntax-entry ?- ". 56" table)
860 (modify-syntax-entry ?- ". 12b" table)) 881 (modify-syntax-entry ?- ". 12b" table))
861 ;; newline and formfeed end coments 882 ;; newline and formfeed end coments
@@ -871,55 +892,136 @@ Based on `comint-mode-map'.")
871;; Font lock support 892;; Font lock support
872 893
873(defvar sql-mode-font-lock-object-name 894(defvar sql-mode-font-lock-object-name
874 (list (concat "^\\s-*\\(create\\(\\s-+or\\s-+replace\\)?\\|drop\\|alter\\)?\\s-+" 895 (list (concat "^\\s-*\\(create\\|drop\\|alter\\)\\s-+" ;; lead off with CREATE, DROP or ALTER
875 "\\(\\(global\\s-+\\)?\\(temporary\\s-+\\)?table\\|view\\|package\\(\\s-+body\\)?\\|" 896 "\\(\\w+\\s-+\\)*" ;; optional intervening keywords
876 "proc\\(edure\\)?\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+\\(\\w+\\)") 897 "\\(table\\|view\\|package\\(\\s-+body\\)?\\|proc\\(edure\\)?"
877 8 'font-lock-function-name-face) 898 "\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+"
878 899 "\\(\\w+\\)")
879 "Pattern to match the names of top-level objects in a CREATE, 900 6 'font-lock-function-name-face)
880DROP or ALTER statement. 901
881 902 "Pattern to match the names of top-level objects.
882The format of variable should be a valid `font-lock-keywords' 903
883entry.") 904The pattern matches the name in a CREATE, DROP or ALTER
905statement. The format of variable should be a valid
906`font-lock-keywords' entry.")
907
908(defvar sql-builtin-face
909 (if sql-xemacs-p
910 ;; XEmacs doesn't have the builtin face
911 'font-lock-preprocessor-face
912 ;; GNU Emacs 19 doesn't either
913 (if sql-emacs19-p
914 'font-lock-keyword-face
915 ;; Emacs 2x
916 'font-lock-builtin-face))
917 "Builtin face for font-lock in SQL mode.")
918
919(defvar sql-doc-face
920 (if (or sql-xemacs-p
921 sql-emacs19-p
922 sql-emacs20-p)
923 'font-lock-string-face
924 'font-lock-doc-face)
925 "Documentation face for font-lock in SQL mode.")
926
927(defmacro sql-keywords-re (&rest keywords)
928 "Compile-time generation of regexp matching any one of KEYWORDS."
929 `(eval-when-compile
930 (concat "\\b"
931 (regexp-opt ',keywords t)
932 "\\b")))
884 933
885(defvar sql-mode-ansi-font-lock-keywords 934(defvar sql-mode-ansi-font-lock-keywords
886 (let ((ansi-keywords (eval-when-compile 935 (let ((ansi-funcs (sql-keywords-re
887 (concat "\\b" 936"abs" "avg" "bit_length" "cardinality" "cast" "char_length"
888 (regexp-opt '( 937"character_length" "coalesce" "convert" "count" "current_date"
889 938"current_path" "current_role" "current_time" "current_timestamp"
890"authorization" "avg" "begin" "close" "cobol" "commit" 939"current_user" "extract" "localtime" "localtimestamp" "lower" "max"
891"continue" "count" "declare" "double" "end" "escape" 940"min" "mod" "nullif" "octet_length" "overlay" "placing" "session_user"
892"exec" "fetch" "foreign" "fortran" "found" "go" "goto" "indicator" 941"substring" "sum" "system_user" "translate" "treat" "trim" "upper"
893"key" "language" "max" "min" "module" "numeric" "open" "pascal" "pli" 942"user"
894"precision" "primary" "procedure" "references" "rollback" 943))
895"schema" "section" "some" "sqlcode" "sqlerror" "sum" "work" 944
896 945 (ansi-non-reserved (sql-keywords-re
897) t) "\\b"))) 946"ada" "asensitive" "assignment" "asymmetric" "atomic" "between"
898 (ansi-reserved-words (eval-when-compile 947"bitvar" "called" "catalog_name" "chain" "character_set_catalog"
899 (concat "\\b" 948"character_set_name" "character_set_schema" "checked" "class_origin"
900 (regexp-opt '( 949"cobol" "collation_catalog" "collation_name" "collation_schema"
901 950"column_name" "command_function" "command_function_code" "committed"
902"all" "and" "any" "as" "asc" "between" "by" "check" "create" 951"condition_number" "connection_name" "constraint_catalog"
903"current" "default" "delete" "desc" "distinct" "exists" "float" "for" 952"constraint_name" "constraint_schema" "contains" "cursor_name"
904"from" "grant" "group" "having" "in" "insert" "into" "is" 953"datetime_interval_code" "datetime_interval_precision" "defined"
905"like" "not" "null" "of" "on" "option" "or" "order" "privileges" 954"definer" "dispatch" "dynamic_function" "dynamic_function_code"
906"public" "select" "set" "table" "to" "union" "unique" 955"existing" "exists" "final" "fortran" "generated" "granted"
907"update" "user" "values" "view" "where" "with" 956"hierarchy" "hold" "implementation" "infix" "insensitive" "instance"
908 957"instantiable" "invoker" "key_member" "key_type" "length" "m"
909) t) "\\b"))) 958"message_length" "message_octet_length" "message_text" "method" "more"
910 (ansi-types (eval-when-compile 959"mumps" "name" "nullable" "number" "options" "overlaps" "overriding"
911 (concat "\\b" 960"parameter_mode" "parameter_name" "parameter_ordinal_position"
912 (regexp-opt '( 961"parameter_specific_catalog" "parameter_specific_name"
913 962"parameter_specific_schema" "pascal" "pli" "position" "repeatable"
914;; ANSI Keywords that look like types 963"returned_length" "returned_octet_length" "returned_sqlstate"
915"character" "cursor" "dec" "int" "real" 964"routine_catalog" "routine_name" "routine_schema" "row_count" "scale"
916;; ANSI Reserved Word that look like types 965"schema_name" "security" "self" "sensitive" "serializable"
917"char" "integer" "smallint" 966"server_name" "similar" "simple" "source" "specific_name" "style"
918 967"subclass_origin" "sublist" "symmetric" "system" "table_name"
919) t) "\\b")))) 968"transaction_active" "transactions_committed"
920 (list (cons ansi-keywords 'font-lock-keyword-face) 969"transactions_rolled_back" "transform" "transforms" "trigger_catalog"
921 (cons ansi-reserved-words 'font-lock-keyword-face) 970"trigger_name" "trigger_schema" "type" "uncommitted" "unnamed"
922 (cons ansi-types 'font-lock-type-face))) 971"user_defined_type_catalog" "user_defined_type_name"
972"user_defined_type_schema"
973))
974
975 (ansi-reserved (sql-keywords-re
976"absolute" "action" "add" "admin" "after" "aggregate" "alias" "all"
977"allocate" "alter" "and" "any" "are" "as" "asc" "assertion" "at"
978"authorization" "before" "begin" "both" "breadth" "by" "call"
979"cascade" "cascaded" "case" "catalog" "check" "class" "close"
980"collate" "collation" "column" "commit" "completion" "connect"
981"connection" "constraint" "constraints" "constructor" "continue"
982"corresponding" "create" "cross" "cube" "current" "cursor" "cycle"
983"data" "day" "deallocate" "declare" "default" "deferrable" "deferred"
984"delete" "depth" "deref" "desc" "describe" "descriptor" "destroy"
985"destructor" "deterministic" "diagnostics" "dictionary" "disconnect"
986"distinct" "domain" "drop" "dynamic" "each" "else" "end" "equals"
987"escape" "every" "except" "exception" "exec" "execute" "external"
988"false" "fetch" "first" "for" "foreign" "found" "free" "from" "full"
989"function" "general" "get" "global" "go" "goto" "grant" "group"
990"grouping" "having" "host" "hour" "identity" "ignore" "immediate" "in"
991"indicator" "initialize" "initially" "inner" "inout" "input" "insert"
992"intersect" "into" "is" "isolation" "iterate" "join" "key" "language"
993"last" "lateral" "leading" "left" "less" "level" "like" "limit"
994"local" "locator" "map" "match" "minute" "modifies" "modify" "module"
995"month" "names" "natural" "new" "next" "no" "none" "not" "null" "of"
996"off" "old" "on" "only" "open" "operation" "option" "or" "order"
997"ordinality" "out" "outer" "output" "pad" "parameter" "parameters"
998"partial" "path" "postfix" "prefix" "preorder" "prepare" "preserve"
999"primary" "prior" "privileges" "procedure" "public" "read" "reads"
1000"recursive" "references" "referencing" "relative" "restrict" "result"
1001"return" "returns" "revoke" "right" "role" "rollback" "rollup"
1002"routine" "rows" "savepoint" "schema" "scroll" "search" "second"
1003"section" "select" "sequence" "session" "set" "sets" "size" "some"
1004"space" "specific" "specifictype" "sql" "sqlexception" "sqlstate"
1005"sqlwarning" "start" "state" "statement" "static" "structure" "table"
1006"temporary" "terminate" "than" "then" "timezone_hour"
1007"timezone_minute" "to" "trailing" "transaction" "translation"
1008"trigger" "true" "under" "union" "unique" "unknown" "unnest" "update"
1009"usage" "using" "value" "values" "variable" "view" "when" "whenever"
1010"where" "with" "without" "work" "write" "year"
1011))
1012
1013 (ansi-types (sql-keywords-re
1014"array" "binary" "bit" "blob" "boolean" "char" "character" "clob"
1015"date" "dec" "decimal" "double" "float" "int" "integer" "interval"
1016"large" "national" "nchar" "nclob" "numeric" "object" "precision"
1017"real" "ref" "row" "scope" "smallint" "time" "timestamp" "varchar"
1018"varying" "zone"
1019)))
1020
1021 `((,ansi-non-reserved . font-lock-keyword-face)
1022 (,ansi-reserved . font-lock-keyword-face)
1023 (,ansi-funcs . ,sql-builtin-face)
1024 (,ansi-types . font-lock-type-face)))
923 1025
924 "ANSI SQL keywords used by font-lock. 1026 "ANSI SQL keywords used by font-lock.
925 1027
@@ -930,66 +1032,156 @@ you define your own sql-mode-ansi-font-lock-keywords. You may want to
930add functions and PL/SQL keywords.") 1032add functions and PL/SQL keywords.")
931 1033
932(defvar sql-mode-oracle-font-lock-keywords 1034(defvar sql-mode-oracle-font-lock-keywords
933 (let ((oracle-keywords (eval-when-compile 1035 (let ((oracle-functions (sql-keywords-re
934 (concat "\\b" 1036"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2"
935 (regexp-opt '( 1037"avg" "bfilename" "bin_to_num" "bitand" "cast" "ceil" "chartorowid"
936;; Oracle (+ANSI) SQL keywords 1038"chr" "coalesce" "compose" "concat" "convert" "corr" "cos" "cosh"
937 1039"count" "covar_pop" "covar_samp" "cume_dist" "current_date"
938; ANSI keywords 1040"current_timestamp" "current_user" "dbtimezone" "decode" "decompose"
939"authorization" "avg" "begin" "close" "cobol" "commit" 1041"dense_rank" "depth" "deref" "dump" "empty_clob" "existsnode" "exp"
940"continue" "count" "declare" "double" "end" "escape" 1042"extract" "extractvalue" "first" "first_value" "floor" "following"
941"exec" "fetch" "foreign" "fortran" "found" "go" "goto" "indicator" 1043"from_tz" "greatest" "group_id" "grouping_id" "hextoraw" "initcap"
942"key" "language" "max" "min" "module" "numeric" "open" "pascal" "pli" 1044"instr" "lag" "last" "last_day" "last_value" "lead" "least" "length"
943"precision" "primary" "procedure" "references" "rollback" 1045"ln" "localtimestamp" "lower" "lpad" "ltrim" "make_ref" "max" "min"
944"schema" "section" "some" "sqlcode" "sqlerror" "sum" "work" 1046"mod" "months_between" "new_time" "next_day" "nls_charset_decl_len"
945 1047"nls_charset_id" "nls_charset_name" "nls_initcap" "nls_lower"
946; ANSI reserved words 1048"nls_upper" "nlssort" "ntile" "nullif" "numtodsinterval"
947"all" "and" "any" "as" "asc" "between" "by" "check" "create" 1049"numtoyminterval" "nvl" "nvl2" "over" "path" "percent_rank"
948"current" "default" "delete" "desc" "distinct" "exists" "float" "for" 1050"percentile_cont" "percentile_disc" "power" "preceding" "rank"
949"from" "grant" "group" "having" "in" "insert" "into" "is" 1051"ratio_to_report" "rawtohex" "rawtonhex" "reftohex" "regr_"
950"like" "not" "null" "of" "on" "option" "or" "order" "privileges" 1052"regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2"
951"public" "select" "set" "table" "to" "union" "unique" 1053"regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "replace" "round"
952"update" "user" "values" "view" "where" "with" 1054"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim"
953 1055"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev"
954"access" "add" "admin" "after" "allocate" "alter" "analyze" "archive" 1056"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path"
955"archivelog" "audit" "authid" "backup" "become" "before" "block" 1057"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid"
956"body" "cache" "cancel" "cascade" "change" "checkpoint" "cluster" 1058"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh"
957"comment" "compile" "compress" "compute" "connect" "constraint" 1059"to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte"
958"constraints" "contents" "controlfile" "cross" "currval" "cycle" 1060"to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp"
959"database" "datafile" "dba" "deterministic" "disable" "dismount" 1061"to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc"
960"drop" "dump" "each" "else" "else" "elsif" "enable" "events" "except" 1062"tz_offset" "uid" "unbounded" "unistr" "updatexml" "upper" "user"
961"exceptions" "exclusive" "execute" "exit" "explain" "extent" 1063"userenv" "var_pop" "var_samp" "variance" "vsize" "width_bucket" "xml"
962"externally" "false" "file" "flush" "force" "freelist" "freelists" 1064"xmlagg" "xmlattribute" "xmlcolattval" "xmlconcat" "xmlelement"
963"full" "function" "global" "grant" "groups" "identified" "if" 1065"xmlforest" "xmlsequence" "xmltransform"
964"immediate" "including" "increment" "index" "initial" "initrans" 1066))
965"inner" "instance" "intersect" "join" "layer" "left" "level" "link" 1067
966"lists" "lock" "logfile" "long" "loop" "manage" "manual" 1068 (oracle-keywords (sql-keywords-re
967"maxdatafiles" "maxextents" "maxinistances" "maxlogfiles" 1069"abort" "access" "accessed" "account" "activate" "add" "admin"
968"maxloghistory" "maxlogmembers" "maxtrans" "maxvalue" "merge" 1070"advise" "after" "agent" "aggregate" "all" "allocate" "allow" "alter"
969"minextents" "minus" "minvalue" "mode" "modify" "mount" "natural" 1071"always" "analyze" "ancillary" "and" "any" "apply" "archive"
970"new" "next" "nextval" "noarchivelog" "noaudit" "nocache" "nocompress" 1072"archivelog" "array" "as" "asc" "associate" "at" "attribute"
971"nocycle" "nomaxvalue" "nominvalue" "none" "noorder" "noresetlogs" 1073"attributes" "audit" "authenticated" "authid" "authorization" "auto"
972"normal" "nosort" "nowait" "off" "offline" "old" "online" "only" 1074"autoallocate" "automatic" "availability" "backup" "before" "begin"
973"optimal" "others" "out" "outer" "over" "own" "package" "parallel" 1075"behalf" "between" "binding" "bitmap" "block" "blocksize" "body"
974"parallel_enable" "pctfree" "pctincrease" "pctused" "plan" "pragma" 1076"both" "buffer_pool" "build" "by" "cache" "call" "cancel"
975"preserve" "prior" "private" "profile" "quota" "raise" "raw" "read" 1077"cascade" "case" "category" "certificate" "chained" "change" "check"
976"recover" "referencing" "rename" "replace" "resetlogs" "resource" 1078"checkpoint" "child" "chunk" "class" "clear" "clone" "close" "cluster"
977"restrict_references" "restricted" "return" "returning" "reuse" 1079"column" "column_value" "columns" "comment" "commit" "committed"
978"revoke" "right" "rnds" "rnps" "role" "roles" "row" "rowlabel" 1080"compatibility" "compile" "complete" "composite_limit" "compress"
979"rownum" "rows" "savepoint" "scn" "segment" "sequence" "session" 1081"compute" "connect" "connect_time" "consider" "consistent"
980"share" "shared" "size" "snapshot" "sort" "statement_id" "statistics" 1082"constraint" "constraints" "constructor" "contents" "context"
981"stop" "storage" "subtype" "successful" "switch" "synonym" "sysdate" 1083"continue" "controlfile" "corruption" "cost" "cpu_per_call"
982"system" "tables" "tablespace" "temporary" "then" "thread" "tracing" 1084"cpu_per_session" "create" "cross" "cube" "current" "currval" "cycle"
983"transaction" "trigger" "triggers" "true" "truncate" "type" "uid" 1085"dangling" "data" "database" "datafile" "datafiles" "day" "ddl"
984"under" "unlimited" "until" "use" "using" "validate" "when" "while" 1086"deallocate" "debug" "default" "deferrable" "deferred" "definer"
985"wnds" "wnps" "write" 1087"delay" "delete" "demand" "desc" "determines" "deterministic"
986 1088"dictionary" "dimension" "directory" "disable" "disassociate"
987) t) "\\b"))) 1089"disconnect" "distinct" "distinguished" "distributed" "dml" "drop"
988 (oracle-warning-words (eval-when-compile 1090"each" "element" "else" "enable" "end" "equals_path" "escape"
989 (concat "\\b" 1091"estimate" "except" "exceptions" "exchange" "excluding" "exists"
990 (regexp-opt '( 1092"expire" "explain" "extent" "external" "externally"
991;; PLSQL defined exceptions 1093"failed_login_attempts" "fast" "file" "final" "finish" "flush" "for"
992 1094"force" "foreign" "freelist" "freelists" "freepools" "fresh" "from"
1095"full" "function" "functions" "generated" "global" "global_name"
1096"globally" "grant" "group" "grouping" "groups" "guard" "hash"
1097"hashkeys" "having" "heap" "hierarchy" "id" "identified" "identifier"
1098"idle_time" "immediate" "in" "including" "increment" "index" "indexed"
1099"indexes" "indextype" "indextypes" "indicator" "initial" "initialized"
1100"initially" "initrans" "inner" "insert" "instance" "instantiable"
1101"instead" "intersect" "into" "invalidate" "is" "isolation" "java"
1102"join" "keep" "key" "kill" "language" "left" "less" "level"
1103"levels" "library" "like" "like2" "like4" "likec" "limit" "link"
1104"list" "lob" "local" "location" "locator" "lock" "log" "logfile"
1105"logging" "logical" "logical_reads_per_call"
1106"logical_reads_per_session" "managed" "management" "manual" "map"
1107"mapping" "master" "matched" "materialized" "maxdatafiles"
1108"maxextents" "maximize" "maxinstances" "maxlogfiles" "maxloghistory"
1109"maxlogmembers" "maxsize" "maxtrans" "maxvalue" "member" "memory"
1110"merge" "migrate" "minextents" "minimize" "minimum" "minus" "minvalue"
1111"mode" "modify" "monitoring" "month" "mount" "move" "movement" "name"
1112"named" "natural" "nested" "never" "new" "next" "nextval" "no"
1113"noarchivelog" "noaudit" "nocache" "nocompress" "nocopy" "nocycle"
1114"nodelay" "noforce" "nologging" "nomapping" "nomaxvalue" "nominimize"
1115"nominvalue" "nomonitoring" "none" "noorder" "noparallel" "norely"
1116"noresetlogs" "noreverse" "normal" "norowdependencies" "nosort"
1117"noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null"
1118"nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online"
1119"only" "open" "operator" "optimal" "option" "or" "order"
1120"organization" "out" "outer" "outline" "overflow" "overriding"
1121"package" "packages" "parallel" "parallel_enable" "parameters"
1122"parent" "partition" "partitions" "password" "password_grace_time"
1123"password_life_time" "password_lock_time" "password_reuse_max"
1124"password_reuse_time" "password_verify_function" "pctfree"
1125"pctincrease" "pctthreshold" "pctused" "pctversion" "percent"
1126"performance" "permanent" "pfile" "physical" "pipelined" "plan"
1127"post_transaction" "pragma" "prebuilt" "preserve" "primary" "private"
1128"private_sga" "privileges" "procedure" "profile" "protection" "public"
1129"purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild"
1130"records_per_block" "recover" "recovery" "recycle" "reduced" "ref"
1131"references" "referencing" "refresh" "register" "reject" "relational"
1132"rely" "rename" "reset" "resetlogs" "resize" "resolve" "resolver"
1133"resource" "restrict" "restrict_references" "restricted" "result"
1134"resumable" "resume" "retention" "return" "returning" "reuse"
1135"reverse" "revoke" "rewrite" "right" "rnds" "rnps" "role" "roles"
1136"rollback" "rollup" "row" "rowdependencies" "rownum" "rows" "sample"
1137"savepoint" "scan" "schema" "scn" "scope" "segment" "select"
1138"selectivity" "self" "sequence" "serializable" "session"
1139"sessions_per_user" "set" "sets" "settings" "shared" "shared_pool"
1140"shrink" "shutdown" "siblings" "sid" "single" "size" "skip" "some"
1141"sort" "source" "space" "specification" "spfile" "split" "standby"
1142"start" "statement_id" "static" "statistics" "stop" "storage" "store"
1143"structure" "subpartition" "subpartitions" "substitutable"
1144"successful" "supplemental" "suspend" "switch" "switchover" "synonym"
1145"sys" "system" "table" "tables" "tablespace" "tempfile" "template"
1146"temporary" "test" "than" "then" "thread" "through" "time_zone"
1147"timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate"
1148"trust" "type" "types" "unarchived" "under" "under_path" "undo"
1149"uniform" "union" "unique" "unlimited" "unlock" "unquiesce"
1150"unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage"
1151"use" "using" "validate" "validation" "value" "values" "variable"
1152"varray" "version" "view" "wait" "when" "whenever" "where" "with"
1153"without" "wnds" "wnps" "work" "write" "xmldata" "xmlschema" "xmltype"
1154))
1155
1156 (oracle-types (sql-keywords-re
1157"bfile" "blob" "byte" "char" "character" "clob" "date" "dec" "decimal"
1158"double" "float" "int" "integer" "interval" "long" "national" "nchar"
1159"nclob" "number" "numeric" "nvarchar2" "precision" "raw" "real"
1160"rowid" "second" "smallint" "time" "timestamp" "urowid" "varchar"
1161"varchar2" "varying" "year" "zone"
1162))
1163
1164 (plsql-functions (sql-keywords-re
1165"%bulk_rowcount" "%found" "%isopen" "%notfound" "%rowcount" "%rowtype"
1166"%type" "extend" "prior"
1167))
1168
1169 (plsql-keywords (sql-keywords-re
1170"autonomous_transaction" "bulk" "char_base" "collect" "constant"
1171"cursor" "declare" "do" "elsif" "exception_init" "execute" "exit"
1172"extends" "false" "fetch" "forall" "goto" "hour" "if" "interface"
1173"loop" "minute" "number_base" "ocirowid" "opaque" "others" "rowtype"
1174"separate" "serially_reusable" "sql" "sqlcode" "sqlerrm" "subtype"
1175"the" "timezone_abbr" "timezone_hour" "timezone_minute"
1176"timezone_region" "true" "varrying" "while"
1177))
1178
1179 (plsql-type (sql-keywords-re
1180"binary_integer" "boolean" "naturaln" "pls_integer" "positive"
1181"positiven" "record" "signtype" "string"
1182))
1183
1184 (plsql-warning (sql-keywords-re
993"access_into_null" "case_not_found" "collection_is_null" 1185"access_into_null" "case_not_found" "collection_is_null"
994"cursor_already_open" "dup_val_on_index" "invalid_cursor" 1186"cursor_already_open" "dup_val_on_index" "invalid_cursor"
995"invalid_number" "login_denied" "no_data_found" "not_logged_on" 1187"invalid_number" "login_denied" "no_data_found" "not_logged_on"
@@ -997,15 +1189,11 @@ add functions and PL/SQL keywords.")
997"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid" 1189"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid"
998"timeout_on_resource" "too_many_rows" "value_error" "zero_divide" 1190"timeout_on_resource" "too_many_rows" "value_error" "zero_divide"
999"exception" "notfound" 1191"exception" "notfound"
1192))
1000 1193
1001) t) "\\b"))) 1194 (sqlplus-commands
1002 1195 (eval-when-compile (concat "^\\(\\("
1003 (oracle-sqlplus-commands 1196 (regexp-opt '(
1004 (eval-when-compile
1005 (concat "^\\(\\("
1006 (regexp-opt '(
1007;; SQL*Plus commands
1008
1009"@" "@@" "accept" "append" "archive" "attribute" "break" 1197"@" "@@" "accept" "append" "archive" "attribute" "break"
1010"btitle" "change" "clear" "column" "connect" "copy" "define" 1198"btitle" "change" "clear" "column" "connect" "copy" "define"
1011"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" 1199"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
@@ -1040,73 +1228,16 @@ add functions and PL/SQL keywords.")
1040 "timi\\(ng\\)?\\|trim\\(out\\)?\\|trims\\(pool\\)?\\|" 1228 "timi\\(ng\\)?\\|trim\\(out\\)?\\|trims\\(pool\\)?\\|"
1041 "und\\(erline\\)?\\|ver\\(ify\\)?\\|wra\\(p\\)?\\)\\)\\)" 1229 "und\\(erline\\)?\\|ver\\(ify\\)?\\|wra\\(p\\)?\\)\\)\\)"
1042 "\\b.*$" 1230 "\\b.*$"
1043 ))) 1231 ))))
1044 1232
1045 (oracle-types 1233 `((,sqlplus-commands . ,sql-doc-face)
1046 (eval-when-compile 1234 (,oracle-functions . ,sql-builtin-face)
1047 (concat "\\b" 1235 (,oracle-keywords . font-lock-keyword-face)
1048 (regexp-opt '( 1236 (,oracle-types . font-lock-type-face)
1049;; Oracle Keywords that look like types 1237 (,plsql-functions . ,sql-builtin-face)
1050;; Oracle Reserved Words that look like types 1238 (,plsql-keywords . font-lock-keyword-face)
1051 1239 (,plsql-type . font-lock-type-face)
1052"bfile" "binary_integer" "blob" "boolean" "byte" "char" "character" 1240 (,plsql-warning . font-lock-warning-face)))
1053"clob" "date" "day" "dec" "decimal" "double" "float" "int" "integer"
1054"interval" "local" "long" "month" "natural" "naturaln" "nchar" "nclob"
1055"number" "numeric" "nvarchar2" "pls_integer" "positive" "positiven"
1056"precision" "raw" "real" "rowid" "second" "signtype" "smallint"
1057"string" "time" "timestamp" "urowid" "varchar" "varchar2" "year"
1058"zone"
1059
1060) t) "\\b")))
1061 (oracle-builtin-functions (eval-when-compile
1062 (concat "\\b"
1063 (regexp-opt '(
1064;; Misc Oracle builtin functions
1065
1066"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2"
1067"avg" "bfilename" "bin_to_num" "bitand" "case" "cast" "ceil"
1068"chartorowid" "chr" "coalesce" "compose" "concat" "convert" "corr"
1069"cos" "cosh" "count" "covar_pop" "covar_samp" "cume_dist"
1070"current_date" "current_timestamp" "current_user" "dbtimezone"
1071"decode" "decompose" "dense_rank" "depth" "deref" "dump" "empty_blob"
1072"empty_clob" "existsnode" "exp" "extract" "extractvalue" "first"
1073"first_value" "floor" "from_tz" "greatest" "group_id" "grouping"
1074"grouping_id" "hextoraw" "initcap" "instr" "lag" "last" "last_day"
1075"last_value" "lead" "least" "length" "ln" "localtimestamp" "log"
1076"lower" "lpad" "ltrim" "make_ref" "max" "min" "mod" "months_between"
1077"nchr" "new_time" "next_day" "nls_charset_decl_len" "nls_charset_id"
1078"nls_charset_name" "nls_initcap" "nls_lower" "nlssort" "nls_upper"
1079"ntile" "nullif" "numtodsinterval" "numtoyminterval" "nvl" "nvl2"
1080"path" "percent_rank" "percentile_cont" "percentile_disc" "power"
1081"rank" "ratio_to_report" "rawtohex" "rawtonhex" "ref" "reftohex"
1082"regr_slope" "regr_intercept" "regr_count" "regr_r2" "regr_avgx"
1083"regr_avgy" "regr_sxx" "regr_syy" "regr_sxy" "round"
1084"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim"
1085"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev"
1086"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path"
1087"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid"
1088"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh"
1089"to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte"
1090"to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp"
1091"to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc"
1092"tz_offset" "uid" "unistr" "updatexml" "upper" "user" "userenv"
1093"value" "var_pop" "var_samp" "variance" "vsize" "width_bucket"
1094"xmlagg" "xmlcolattval" "xmlconcat" "xmlelement" "xmlforest"
1095"xmlsequence" "xmltransform"
1096
1097) t) "\\b"))))
1098 (list (cons oracle-sqlplus-commands 'font-lock-doc-face)
1099 (cons oracle-keywords 'font-lock-keyword-face)
1100 (cons oracle-warning-words 'font-lock-warning-face)
1101 ;; XEmacs doesn't have font-lock-builtin-face
1102 (if (string-match "XEmacs\\|Lucid" emacs-version)
1103 (cons oracle-builtin-functions 'font-lock-preprocessor-face)
1104 ;; GNU Emacs 19 doesn't have it either
1105 (if (string-match "GNU Emacs 19" emacs-version)
1106 (cons oracle-builtin-functions 'font-lock-keyword-face)
1107 ;; Emacs
1108 (cons oracle-builtin-functions 'font-lock-builtin-face)))
1109 (cons oracle-types 'font-lock-type-face)))
1110 1241
1111 "Oracle SQL keywords used by font-lock. 1242 "Oracle SQL keywords used by font-lock.
1112 1243
@@ -1117,42 +1248,84 @@ you define your own sql-mode-oracle-font-lock-keywords. You may want
1117to add functions and PL/SQL keywords.") 1248to add functions and PL/SQL keywords.")
1118 1249
1119(defvar sql-mode-postgres-font-lock-keywords 1250(defvar sql-mode-postgres-font-lock-keywords
1120 (let ((postgres-reserved-words (eval-when-compile 1251 (let ((pg-funcs (sql-keywords-re
1121 (concat "\\b" 1252"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan"
1122 (regexp-opt '( 1253"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil"
1123"language" 1254"center" "char_length" "chr" "coalesce" "col_description" "convert"
1124) t) "\\b"))) 1255"cos" "cot" "count" "current_database" "current_date" "current_schema"
1125 (postgres-types (eval-when-compile 1256"current_schemas" "current_setting" "current_time" "current_timestamp"
1126 (concat "\\b" 1257"current_user" "currval" "date_part" "date_trunc" "decode" "degrees"
1127 (regexp-opt '( 1258"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte"
1128 1259"has_database_privilege" "has_function_privilege"
1129"bool" "box" "circle" "char" "char2" "char4" "char8" "char16" "date" 1260"has_language_privilege" "has_schema_privilege" "has_table_privilege"
1130"float4" "float8" "int2" "int4" "int8" "line" "lseg" "money" "path" 1261"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading"
1131"point" "polygon" "serial" "text" "time" "timespan" "timestamp" "varchar" 1262"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad"
1132 1263"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval"
1133) t)"\\b"))) 1264"now" "npoints" "nullif" "obj_description" "octet_length" "overlay"
1134 (postgres-builtin-functions (eval-when-compile 1265"pclose" "pg_client_encoding" "pg_function_is_visible"
1135 (concat "\\b" 1266"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef"
1136 (regexp-opt '( 1267"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible"
1137;; Misc Postgres builtin functions 1268"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible"
1138 1269"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians"
1139"abstime" "age" "area" "box" "center" "date_part" "date_trunc" 1270"radius" "random" "repeat" "replace" "round" "rpad" "rtrim"
1140"datetime" "dexp" "diameter" "dpow" "float" "float4" "height" 1271"session_user" "set_bit" "set_byte" "set_config" "set_masklen"
1141"initcap" "integer" "isclosed" "isfinite" "isoldpath" "isopen" 1272"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr"
1142"length" "lower" "lpad" "ltrim" "pclose" "point" "points" "popen" 1273"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date"
1143"position" "radius" "reltime" "revertpoly" "rpad" "rtrim" "substr" 1274"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim"
1144"substring" "text" "timespan" "translate" "trim" "upgradepath" 1275"trunc" "upper" "variance" "version" "width"
1145"upgradepoly" "upper" "varchar" "width" 1276))
1146 1277
1147) t) "\\b")))) 1278 (pg-reserved (sql-keywords-re
1148 (append sql-mode-ansi-font-lock-keywords 1279"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter"
1149 (list (cons postgres-reserved-words 'font-lock-keyword-face) 1280"analyze" "and" "any" "as" "asc" "assignment" "authorization"
1150 ;; XEmacs doesn't have 'font-lock-builtin-face 1281"backward" "basetype" "before" "begin" "between" "binary" "by" "cache"
1151 (if (string-match "XEmacs\\|Lucid" emacs-version) 1282"called" "cascade" "case" "cast" "characteristics" "check"
1152 (cons postgres-builtin-functions 'font-lock-preprocessor-face) 1283"checkpoint" "class" "close" "cluster" "column" "comment" "commit"
1153 ;; Emacs 1284"committed" "commutator" "constraint" "constraints" "conversion"
1154 (cons postgres-builtin-functions 'font-lock-builtin-face)) 1285"copy" "create" "createdb" "createuser" "cursor" "cycle" "database"
1155 (cons postgres-types 'font-lock-type-face)))) 1286"deallocate" "declare" "default" "deferrable" "deferred" "definer"
1287"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each"
1288"element" "else" "encoding" "encrypted" "end" "escape" "except"
1289"exclusive" "execute" "exists" "explain" "extended" "external" "false"
1290"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from"
1291"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having"
1292"immediate" "immutable" "implicit" "in" "increment" "index" "inherits"
1293"initcond" "initially" "input" "insensitive" "insert" "instead"
1294"internallength" "intersect" "into" "invoker" "is" "isnull"
1295"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
1296"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
1297"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
1298"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
1299"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
1300"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
1301"prepare" "primary" "prior" "privileges" "procedural" "procedure"
1302"public" "read" "recheck" "references" "reindex" "relative" "rename"
1303"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
1304"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
1305"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
1306"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
1307"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
1308"transaction" "trigger" "true" "truncate" "trusted" "type"
1309"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
1310"usage" "user" "using" "vacuum" "valid" "validator" "values"
1311"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
1312"work"
1313))
1314
1315 (pg-types (sql-keywords-re
1316"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char"
1317"character" "cidr" "circle" "cstring" "date" "decimal" "double"
1318"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal"
1319"interval" "language_handler" "line" "lseg" "macaddr" "money"
1320"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real"
1321"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure"
1322"regtype" "serial" "serial4" "serial8" "smallint" "text" "time"
1323"timestamp" "varchar" "varying" "void" "zone"
1324)))
1325
1326 `((,pg-funcs . ,sql-builtin-face)
1327 (,pg-reserved . font-lock-keyword-face)
1328 (,pg-types . font-lock-type-face)))
1156 1329
1157 "Postgres SQL keywords used by font-lock. 1330 "Postgres SQL keywords used by font-lock.
1158 1331
@@ -1162,10 +1335,7 @@ function `regexp-opt'. Therefore, take a look at the source before
1162you define your own sql-mode-postgres-font-lock-keywords.") 1335you define your own sql-mode-postgres-font-lock-keywords.")
1163 1336
1164(defvar sql-mode-linter-font-lock-keywords 1337(defvar sql-mode-linter-font-lock-keywords
1165 (let ((linter-keywords (eval-when-compile 1338 (let ((linter-keywords (sql-keywords-re
1166 (concat "\\b"
1167 (regexp-opt '(
1168
1169"autocommit" "autoinc" "autorowid" "cancel" "cascade" "channel" 1339"autocommit" "autoinc" "autorowid" "cancel" "cascade" "channel"
1170"committed" "count" "countblob" "cross" "current" "data" "database" 1340"committed" "count" "countblob" "cross" "current" "data" "database"
1171"datafile" "datafiles" "datesplit" "dba" "dbname" "default" "deferred" 1341"datafile" "datafiles" "datesplit" "dba" "dbname" "default" "deferred"
@@ -1190,12 +1360,9 @@ you define your own sql-mode-postgres-font-lock-keywords.")
1190"trigger_info_size" "true" "trunc" "uncommitted" "unicode" "unknown" 1360"trigger_info_size" "true" "trunc" "uncommitted" "unicode" "unknown"
1191"unlimited" "unlisted" "user" "utf8" "value" "varying" "volumes" 1361"unlimited" "unlisted" "user" "utf8" "value" "varying" "volumes"
1192"wait" "windows_code" "workspace" "write" "xml" 1362"wait" "windows_code" "workspace" "write" "xml"
1363))
1193 1364
1194) t) "\\b"))) 1365 (linter-reserved (sql-keywords-re
1195 (linter-reserved-words (eval-when-compile
1196 (concat "\\b"
1197 (regexp-opt '(
1198
1199"access" "action" "add" "address" "after" "all" "alter" "always" "and" 1366"access" "action" "add" "address" "after" "all" "alter" "always" "and"
1200"any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit" 1367"any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit"
1201"aud_obj_name_len" "backup" "base" "before" "between" "blobfile" 1368"aud_obj_name_len" "backup" "base" "before" "between" "blobfile"
@@ -1213,22 +1380,16 @@ you define your own sql-mode-postgres-font-lock-keywords.")
1213"start" "stop" "sync" "synchronize" "synonym" "sysdate" "table" "then" 1380"start" "stop" "sync" "synchronize" "synonym" "sysdate" "table" "then"
1214"to" "union" "unique" "unlock" "until" "update" "using" "values" 1381"to" "union" "unique" "unlock" "until" "update" "using" "values"
1215"view" "when" "where" "with" "without" 1382"view" "when" "where" "with" "without"
1383))
1216 1384
1217) t) "\\b"))) 1385 (linter-types (sql-keywords-re
1218 (linter-types (eval-when-compile
1219 (concat "\\b"
1220 (regexp-opt '(
1221
1222"bigint" "bitmap" "blob" "boolean" "char" "character" "date" 1386"bigint" "bitmap" "blob" "boolean" "char" "character" "date"
1223"datetime" "dec" "decimal" "double" "float" "int" "integer" "nchar" 1387"datetime" "dec" "decimal" "double" "float" "int" "integer" "nchar"
1224"number" "numeric" "real" "smallint" "varbyte" "varchar" "byte" 1388"number" "numeric" "real" "smallint" "varbyte" "varchar" "byte"
1225"cursor" "long" 1389"cursor" "long"
1390))
1226 1391
1227) t) "\\b"))) 1392 (linter-functions (sql-keywords-re
1228 (linter-builtin-functions (eval-when-compile
1229 (concat "\\b"
1230 (regexp-opt '(
1231
1232"abs" "acos" "asin" "atan" "atan2" "avg" "ceil" "cos" "cosh" "divtime" 1393"abs" "acos" "asin" "atan" "atan2" "avg" "ceil" "cos" "cosh" "divtime"
1233"exp" "floor" "getbits" "getblob" "getbyte" "getlong" "getraw" 1394"exp" "floor" "getbits" "getblob" "getbyte" "getlong" "getraw"
1234"getstr" "gettext" "getword" "hextoraw" "lenblob" "length" "log" 1395"getstr" "gettext" "getword" "hextoraw" "lenblob" "length" "log"
@@ -1239,20 +1400,12 @@ you define your own sql-mode-postgres-font-lock-keywords.")
1239"to_gmtime" "to_localtime" "to_number" "trim" "upper" "decode" 1400"to_gmtime" "to_localtime" "to_number" "trim" "upper" "decode"
1240"substr" "substring" "chr" "dayname" "days" "greatest" "hex" "initcap" 1401"substr" "substring" "chr" "dayname" "days" "greatest" "hex" "initcap"
1241"instr" "least" "multime" "replace" "width" 1402"instr" "least" "multime" "replace" "width"
1403)))
1242 1404
1243) t) "\\b")))) 1405 `((,linter-keywords . font-lock-keyword-face)
1244 (append sql-mode-ansi-font-lock-keywords 1406 (,linter-reserved . font-lock-keyword-face)
1245 (list (cons linter-keywords 'font-lock-keywords-face) 1407 (,linter-functions . ,sql-builtin-face)
1246 (cons linter-reserved-words 'font-lock-keyword-face) 1408 (,linter-types . font-lock-type-face)))
1247 ;; XEmacs doesn't have font-lock-builtin-face
1248 (if (string-match "XEmacs\\|Lucid" emacs-version)
1249 (cons linter-builtin-functions 'font-lock-preprocessor-face)
1250 ;; GNU Emacs 19 doesn't have it either
1251 (if (string-match "GNU Emacs 19" emacs-version)
1252 (cons linter-builtin-functions 'font-lock-keywords-face)
1253 ;; Emacs
1254 (cons linter-builtin-functions 'font-lock-builtin-face)))
1255 (cons linter-types 'font-lock-type-face))))
1256 1409
1257 "Linter SQL keywords used by font-lock. 1410 "Linter SQL keywords used by font-lock.
1258 1411
@@ -1261,21 +1414,18 @@ regular expressions are created during compilation by calling the
1261function `regexp-opt'.") 1414function `regexp-opt'.")
1262 1415
1263(defvar sql-mode-ms-font-lock-keywords 1416(defvar sql-mode-ms-font-lock-keywords
1264 (let ((ms-reserved-words (eval-when-compile 1417 (let ((ms-reserved (sql-keywords-re
1265 (concat "\\b"
1266 (regexp-opt '(
1267
1268"absolute" "add" "all" "alter" "and" "any" "as" "asc" "authorization" 1418"absolute" "add" "all" "alter" "and" "any" "as" "asc" "authorization"
1269"avg" "backup" "begin" "between" "break" "browse" "bulk" "by" 1419"avg" "backup" "begin" "between" "break" "browse" "bulk" "by"
1270"cascade" "case" "check" "checkpoint" "close" "clustered" "coalesce" 1420"cascade" "case" "check" "checkpoint" "close" "clustered" "coalesce"
1271"column" "commit" "committed" "compute" "confirm" "constraint" 1421"column" "commit" "committed" "compute" "confirm" "constraint"
1272"contains" "containstable" "continue" "controlrow" "convert" "count" 1422"contains" "containstable" "continue" "controlrow" "convert" "count"
1273"create" "cross" "current" "current_date" "current_time" 1423"create" "cross" "current" "current_date" "current_time"
1274"current_timestamp" "current_user" "database" "deallocate" 1424"current_timestamp" "current_user" "database" "deallocate" "declare"
1275"declare" "default" "delete" "deny" "desc" "disk" "distinct" 1425"default" "delete" "deny" "desc" "disk" "distinct" "distributed"
1276"distributed" "double" "drop" "dummy" "dump" "else" "end" "errlvl" 1426"double" "drop" "dummy" "dump" "else" "end" "errlvl" "errorexit"
1277"errorexit" "escape" "except" "exec" "execute" "exists" "exit" "fetch" 1427"escape" "except" "exec" "execute" "exists" "exit" "fetch" "file"
1278"file" "fillfactor" "first" "floppy" "for" "foreign" "freetext" 1428"fillfactor" "first" "floppy" "for" "foreign" "freetext"
1279"freetexttable" "from" "full" "goto" "grant" "group" "having" 1429"freetexttable" "from" "full" "goto" "grant" "group" "having"
1280"holdlock" "identity" "identity_insert" "identitycol" "if" "in" 1430"holdlock" "identity" "identity_insert" "identitycol" "if" "in"
1281"index" "inner" "insert" "intersect" "into" "is" "isolation" "join" 1431"index" "inner" "insert" "intersect" "into" "is" "isolation" "join"
@@ -1295,29 +1445,21 @@ function `regexp-opt'.")
1295"textsize" "then" "to" "top" "tran" "transaction" "trigger" "truncate" 1445"textsize" "then" "to" "top" "tran" "transaction" "trigger" "truncate"
1296"tsequal" "uncommitted" "union" "unique" "update" "updatetext" 1446"tsequal" "uncommitted" "union" "unique" "update" "updatetext"
1297"updlock" "use" "user" "values" "view" "waitfor" "when" "where" 1447"updlock" "use" "user" "values" "view" "waitfor" "when" "where"
1298"while" "with" "work" "writetext" 1448"while" "with" "work" "writetext" "collate" "function" "openxml"
1299"collate" "function" "openxml" "returns" 1449"returns"
1300 1450))
1301) t) "\\b")))
1302 (ms-types (eval-when-compile
1303 (concat "\\b"
1304 (regexp-opt '(
1305 1451
1452 (ms-types (sql-keywords-re
1306"binary" "bit" "char" "character" "cursor" "datetime" "dec" "decimal" 1453"binary" "bit" "char" "character" "cursor" "datetime" "dec" "decimal"
1307"double" "float" "image" "int" "integer" "money" "national" "nchar" 1454"double" "float" "image" "int" "integer" "money" "national" "nchar"
1308"ntext" "numeric" "numeric" "nvarchar" "precision" "real" 1455"ntext" "numeric" "numeric" "nvarchar" "precision" "real"
1309"smalldatetime" "smallint" "smallmoney" "text" "timestamp" "tinyint" 1456"smalldatetime" "smallint" "smallmoney" "text" "timestamp" "tinyint"
1310"uniqueidentifier" "varbinary" "varchar" "varying" 1457"uniqueidentifier" "varbinary" "varchar" "varying"
1311 1458))
1312) t) "\\b")))
1313 1459
1314 (ms-vars "\\b@[a-zA-Z0-9_]*\\b") 1460 (ms-vars "\\b@[a-zA-Z0-9_]*\\b")
1315 1461
1316 (ms-builtin-functions (eval-when-compile 1462 (ms-functions (sql-keywords-re
1317 (concat "\\b"
1318 (regexp-opt '(
1319;; Misc MS builtin functions
1320
1321"@@connections" "@@cpu_busy" "@@cursor_rows" "@@datefirst" "@@dbts" 1463"@@connections" "@@cpu_busy" "@@cursor_rows" "@@datefirst" "@@dbts"
1322"@@error" "@@fetch_status" "@@identity" "@@idle" "@@io_busy" 1464"@@error" "@@fetch_status" "@@identity" "@@idle" "@@io_busy"
1323"@@langid" "@@language" "@@lock_timeout" "@@max_connections" 1465"@@langid" "@@language" "@@lock_timeout" "@@max_connections"
@@ -1346,14 +1488,12 @@ function `regexp-opt'.")
1346"suser_id" "suser_name" "suser_sid" "suser_sname" "system_user" "tan" 1488"suser_id" "suser_name" "suser_sid" "suser_sname" "system_user" "tan"
1347"textptr" "textvalid" "typeproperty" "unicode" "upper" "user" 1489"textptr" "textvalid" "typeproperty" "unicode" "upper" "user"
1348"user_id" "user_name" "var" "varp" "year" 1490"user_id" "user_name" "var" "varp" "year"
1491))
1349 1492
1350) t) "\\b"))) 1493 (ms-commands
1351
1352 (ms-config-commands
1353 (eval-when-compile 1494 (eval-when-compile
1354 (concat "^\\(\\(set\\s-+\\(" 1495 (concat "^\\(\\(set\\s-+\\("
1355 (regexp-opt '( 1496 (regexp-opt '(
1356
1357"datefirst" "dateformat" "deadlock_priority" "lock_timeout" 1497"datefirst" "dateformat" "deadlock_priority" "lock_timeout"
1358"concat_null_yields_null" "cursor_close_on_commit" 1498"concat_null_yields_null" "cursor_close_on_commit"
1359"disable_def_cnst_chk" "fips_flagger" "identity_insert" "language" 1499"disable_def_cnst_chk" "fips_flagger" "identity_insert" "language"
@@ -1364,19 +1504,14 @@ function `regexp-opt'.")
1364"ansi_warnings" "forceplan" "showplan_all" "showplan_text" 1504"ansi_warnings" "forceplan" "showplan_all" "showplan_text"
1365"statistics" "implicit_transactions" "remote_proc_transactions" 1505"statistics" "implicit_transactions" "remote_proc_transactions"
1366"transaction" "xact_abort" 1506"transaction" "xact_abort"
1367
1368) t) 1507) t)
1369 "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$")))) 1508 "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$"))))
1370 1509
1371 (list (cons ms-config-commands 'font-lock-doc-face) 1510 `((,ms-commands . ,sql-doc-face)
1372 (cons ms-reserved-words 'font-lock-keyword-face) 1511 (,ms-reserved . font-lock-keyword-face)
1373 ;; XEmacs doesn't have 'font-lock-builtin-face 1512 (,ms-functions . ,sql-builtin-face)
1374 (if (string-match "XEmacs\\|Lucid" emacs-version) 1513 (,ms-vars . font-lock-variable-name-face)
1375 (cons ms-builtin-functions 'font-lock-preprocessor-face) 1514 (,ms-types . font-lock-type-face)))
1376 ;; Emacs
1377 (cons ms-builtin-functions 'font-lock-builtin-face))
1378 (cons ms-vars 'font-lock-variable-name-face)
1379 (cons ms-types 'font-lock-type-face)))
1380 1515
1381 "Microsoft SQLServer SQL keywords used by font-lock. 1516 "Microsoft SQLServer SQL keywords used by font-lock.
1382 1517
@@ -1385,7 +1520,7 @@ regular expressions are created during compilation by calling the
1385function `regexp-opt'. Therefore, take a look at the source before 1520function `regexp-opt'. Therefore, take a look at the source before
1386you define your own sql-mode-ms-font-lock-keywords.") 1521you define your own sql-mode-ms-font-lock-keywords.")
1387 1522
1388(defvar sql-mode-sybase-font-lock-keywords sql-mode-ansi-font-lock-keywords 1523(defvar sql-mode-sybase-font-lock-keywords nil
1389 "Sybase SQL keywords used by font-lock. 1524 "Sybase SQL keywords used by font-lock.
1390 1525
1391This variable is used by `sql-mode' and `sql-interactive-mode'. The 1526This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1393,7 +1528,7 @@ regular expressions are created during compilation by calling the
1393function `regexp-opt'. Therefore, take a look at the source before 1528function `regexp-opt'. Therefore, take a look at the source before
1394you define your own sql-mode-sybase-font-lock-keywords.") 1529you define your own sql-mode-sybase-font-lock-keywords.")
1395 1530
1396(defvar sql-mode-informix-font-lock-keywords sql-mode-ansi-font-lock-keywords 1531(defvar sql-mode-informix-font-lock-keywords nil
1397 "Informix SQL keywords used by font-lock. 1532 "Informix SQL keywords used by font-lock.
1398 1533
1399This variable is used by `sql-mode' and `sql-interactive-mode'. The 1534This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1401,7 +1536,7 @@ regular expressions are created during compilation by calling the
1401function `regexp-opt'. Therefore, take a look at the source before 1536function `regexp-opt'. Therefore, take a look at the source before
1402you define your own sql-mode-informix-font-lock-keywords.") 1537you define your own sql-mode-informix-font-lock-keywords.")
1403 1538
1404(defvar sql-mode-interbase-font-lock-keywords sql-mode-ansi-font-lock-keywords 1539(defvar sql-mode-interbase-font-lock-keywords nil
1405 "Interbase SQL keywords used by font-lock. 1540 "Interbase SQL keywords used by font-lock.
1406 1541
1407This variable is used by `sql-mode' and `sql-interactive-mode'. The 1542This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1409,7 +1544,7 @@ regular expressions are created during compilation by calling the
1409function `regexp-opt'. Therefore, take a look at the source before 1544function `regexp-opt'. Therefore, take a look at the source before
1410you define your own sql-mode-interbase-font-lock-keywords.") 1545you define your own sql-mode-interbase-font-lock-keywords.")
1411 1546
1412(defvar sql-mode-ingres-font-lock-keywords sql-mode-ansi-font-lock-keywords 1547(defvar sql-mode-ingres-font-lock-keywords nil
1413 "Ingres SQL keywords used by font-lock. 1548 "Ingres SQL keywords used by font-lock.
1414 1549
1415This variable is used by `sql-mode' and `sql-interactive-mode'. The 1550This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1417,7 +1552,7 @@ regular expressions are created during compilation by calling the
1417function `regexp-opt'. Therefore, take a look at the source before 1552function `regexp-opt'. Therefore, take a look at the source before
1418you define your own sql-mode-interbase-font-lock-keywords.") 1553you define your own sql-mode-interbase-font-lock-keywords.")
1419 1554
1420(defvar sql-mode-solid-font-lock-keywords sql-mode-ansi-font-lock-keywords 1555(defvar sql-mode-solid-font-lock-keywords nil
1421 "Solid SQL keywords used by font-lock. 1556 "Solid SQL keywords used by font-lock.
1422 1557
1423This variable is used by `sql-mode' and `sql-interactive-mode'. The 1558This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1425,7 +1560,76 @@ regular expressions are created during compilation by calling the
1425function `regexp-opt'. Therefore, take a look at the source before 1560function `regexp-opt'. Therefore, take a look at the source before
1426you define your own sql-mode-solid-font-lock-keywords.") 1561you define your own sql-mode-solid-font-lock-keywords.")
1427 1562
1428(defvar sql-mode-mysql-font-lock-keywords sql-mode-ansi-font-lock-keywords 1563(defvar sql-mode-mysql-font-lock-keywords
1564 (let ((mysql-funcs (sql-keywords-re
1565"ascii" "avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext"
1566"bdpolyfromwkb" "benchmark" "bin" "bit_and" "bit_length" "bit_or"
1567"bit_xor" "both" "cast" "char_length" "character_length" "coalesce"
1568"concat" "concat_ws" "connection_id" "conv" "convert" "count"
1569"curdate" "current_date" "current_time" "current_timestamp" "curtime"
1570"elt" "encrypt" "export_set" "field" "find_in_set" "found_rows" "from"
1571"geomcollfromtext" "geomcollfromwkb" "geometrycollectionfromtext"
1572"geometrycollectionfromwkb" "geometryfromtext" "geometryfromwkb"
1573"geomfromtext" "geomfromwkb" "get_lock" "group_concat" "hex" "ifnull"
1574"instr" "interval" "isnull" "last_insert_id" "lcase" "leading"
1575"length" "linefromtext" "linefromwkb" "linestringfromtext"
1576"linestringfromwkb" "load_file" "locate" "lower" "lpad" "ltrim"
1577"make_set" "master_pos_wait" "max" "mid" "min" "mlinefromtext"
1578"mlinefromwkb" "mpointfromtext" "mpointfromwkb" "mpolyfromtext"
1579"mpolyfromwkb" "multilinestringfromtext" "multilinestringfromwkb"
1580"multipointfromtext" "multipointfromwkb" "multipolygonfromtext"
1581"multipolygonfromwkb" "now" "nullif" "oct" "octet_length" "ord"
1582"pointfromtext" "pointfromwkb" "polyfromtext" "polyfromwkb"
1583"polygonfromtext" "polygonfromwkb" "position" "quote" "rand"
1584"release_lock" "repeat" "replace" "reverse" "rpad" "rtrim" "soundex"
1585"space" "std" "stddev" "substring" "substring_index" "sum" "sysdate"
1586"trailing" "trim" "ucase" "unix_timestamp" "upper" "user" "variance"
1587))
1588
1589 (mysql-keywords (sql-keywords-re
1590"action" "add" "after" "against" "all" "alter" "and" "as" "asc"
1591"auto_increment" "avg_row_length" "bdb" "between" "by" "cascade"
1592"case" "change" "character" "check" "checksum" "close" "collate"
1593"collation" "column" "columns" "comment" "committed" "concurrent"
1594"constraint" "create" "cross" "data" "database" "default"
1595"delay_key_write" "delayed" "delete" "desc" "directory" "disable"
1596"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else"
1597"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for"
1598"force" "foreign" "from" "full" "fulltext" "global" "group" "handler"
1599"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile"
1600"inner" "insert" "insert_method" "into" "is" "isam" "isolation" "join"
1601"key" "keys" "last" "left" "level" "like" "limit" "lines" "load"
1602"local" "lock" "low_priority" "match" "max_rows" "merge" "min_rows"
1603"mode" "modify" "mrg_myisam" "myisam" "natural" "next" "no" "not"
1604"null" "offset" "oj" "on" "open" "optionally" "or" "order" "outer"
1605"outfile" "pack_keys" "partial" "password" "prev" "primary"
1606"procedure" "quick" "raid0" "raid_type" "read" "references" "rename"
1607"repeatable" "restrict" "right" "rollback" "rollup" "row_format"
1608"savepoint" "select" "separator" "serializable" "session" "set"
1609"share" "show" "sql_big_result" "sql_buffer_result" "sql_cache"
1610"sql_calc_found_rows" "sql_no_cache" "sql_small_result" "starting"
1611"straight_join" "striped" "table" "tables" "temporary" "terminated"
1612"then" "to" "transaction" "truncate" "type" "uncommitted" "union"
1613"unique" "unlock" "update" "use" "using" "values" "when" "where"
1614"with" "write" "xor"
1615))
1616
1617 (mysql-types (sql-keywords-re
1618"bigint" "binary" "bit" "blob" "bool" "boolean" "char" "curve" "date"
1619"datetime" "dec" "decimal" "double" "enum" "fixed" "float" "geometry"
1620"geometrycollection" "int" "integer" "line" "linearring" "linestring"
1621"longblob" "longtext" "mediumblob" "mediumint" "mediumtext"
1622"multicurve" "multilinestring" "multipoint" "multipolygon"
1623"multisurface" "national" "numeric" "point" "polygon" "precision"
1624"real" "smallint" "surface" "text" "time" "timestamp" "tinyblob"
1625"tinyint" "tinytext" "unsigned" "varchar" "year" "year2" "year4"
1626"zerofill"
1627)))
1628
1629 `((,mysql-funcs . ,sql-builtin-face)
1630 (,mysql-keywords . font-lock-keyword-face)
1631 (,mysql-types . font-lock-type-face)))
1632
1429 "MySQL SQL keywords used by font-lock. 1633 "MySQL SQL keywords used by font-lock.
1430 1634
1431This variable is used by `sql-mode' and `sql-interactive-mode'. The 1635This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1433,7 +1637,7 @@ regular expressions are created during compilation by calling the
1433function `regexp-opt'. Therefore, take a look at the source before 1637function `regexp-opt'. Therefore, take a look at the source before
1434you define your own sql-mode-mysql-font-lock-keywords.") 1638you define your own sql-mode-mysql-font-lock-keywords.")
1435 1639
1436(defvar sql-mode-sqlite-font-lock-keywords sql-mode-ansi-font-lock-keywords 1640(defvar sql-mode-sqlite-font-lock-keywords nil
1437 "SQLite SQL keywords used by font-lock. 1641 "SQLite SQL keywords used by font-lock.
1438 1642
1439This variable is used by `sql-mode' and `sql-interactive-mode'. The 1643This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1441,7 +1645,7 @@ regular expressions are created during compilation by calling the
1441function `regexp-opt'. Therefore, take a look at the source before 1645function `regexp-opt'. Therefore, take a look at the source before
1442you define your own sql-mode-sqlite-font-lock-keywords.") 1646you define your own sql-mode-sqlite-font-lock-keywords.")
1443 1647
1444(defvar sql-mode-db2-font-lock-keywords sql-mode-ansi-font-lock-keywords 1648(defvar sql-mode-db2-font-lock-keywords nil
1445 "DB2 SQL keywords used by font-lock. 1649 "DB2 SQL keywords used by font-lock.
1446 1650
1447This variable is used by `sql-mode' and `sql-interactive-mode'. The 1651This variable is used by `sql-mode' and `sql-interactive-mode'. The
@@ -1463,16 +1667,16 @@ highlighting rules in sql-mode.")
1463(defun sql-product-feature (feature &optional product) 1667(defun sql-product-feature (feature &optional product)
1464 "Lookup `feature' needed to support the current SQL product. 1668 "Lookup `feature' needed to support the current SQL product.
1465 1669
1466See \[sql-product-support] for a list of products and supported features." 1670See \[sql-product-alist] for a list of products and supported features."
1467 (cadr 1671 (plist-get
1468 (memq feature 1672 (cdr (assoc (or product sql-product)
1469 (assoc (or product sql-product) 1673 sql-product-alist))
1470 sql-product-support)))) 1674 feature))
1471 1675
1472(defun sql-product-font-lock (keywords-only imenu) 1676(defun sql-product-font-lock (keywords-only imenu)
1473 "Sets `font-lock-defaults' and `font-lock-keywords' based on 1677 "Sets `font-lock-defaults' and `font-lock-keywords' based on
1474the product-specific keywords and syntax-alists defined in 1678the product-specific keywords and syntax-alists defined in
1475`sql-product-support'." 1679`sql-product-alist'."
1476 (let 1680 (let
1477 ;; Get the product-specific syntax-alist. 1681 ;; Get the product-specific syntax-alist.
1478 ((syntax-alist 1682 ((syntax-alist
@@ -1484,6 +1688,7 @@ the product-specific keywords and syntax-alists defined in
1484 (setq sql-mode-font-lock-keywords 1688 (setq sql-mode-font-lock-keywords
1485 (append 1689 (append
1486 (eval (sql-product-feature :font-lock)) 1690 (eval (sql-product-feature :font-lock))
1691 (eval (sql-product-feature :font-lock 'ansi))
1487 (list sql-mode-font-lock-object-name))) 1692 (list sql-mode-font-lock-object-name)))
1488 1693
1489 ;; Setup font-lock. (What is the minimum we should have to do 1694 ;; Setup font-lock. (What is the minimum we should have to do
@@ -1498,12 +1703,34 @@ the product-specific keywords and syntax-alists defined in
1498 (setq imenu-syntax-alist syntax-alist)))) 1703 (setq imenu-syntax-alist syntax-alist))))
1499 1704
1500;;;###autoload 1705;;;###autoload
1501(defun sql-add-product-keywords (product keywords) 1706(defun sql-add-product-keywords (product keywords &optional append)
1502 "Append a `font-lock-keywords' entry to the existing entries defined 1707 "Add highlighting KEYWORDS for SQL PRODUCT.
1503 for the specified `product'." 1708
1504 1709PRODUCT should be a symbol, the name of a sql product, such as
1505 (let ((font-lock (sql-product-feature :font-lock product))) 1710`oracle'. KEYWORDS should be a list; see the variable
1506 (set font-lock (append (eval font-lock) (list keywords))))) 1711`font-lock-keywords'. By default they are added at the beginning
1712of the current highlighting list. If optional argument APPEND is
1713`set', they are used to replace the current highlighting list.
1714If APPEND is any other non-nil value, they are added at the end
1715of the current highlighting list.
1716
1717For example:
1718
1719 (sql-add-product-keywords 'ms
1720 '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
1721
1722adds a fontification pattern to fontify identifiers ending in
1723`_t' as data types."
1724
1725 (let ((font-lock (sql-product-feature :font-lock product))
1726 old)
1727 (setq old (eval font-lock))
1728 (set font-lock
1729 (if (eq append 'set)
1730 keywords
1731 (if append
1732 (append old keywords)
1733 (append keywords old))))))
1507 1734
1508 1735
1509 1736
@@ -1518,7 +1745,8 @@ selected."
1518 (sql-product-font-lock nil t) 1745 (sql-product-font-lock nil t)
1519 1746
1520 ;; Force fontification, if its enabled. 1747 ;; Force fontification, if its enabled.
1521 (if font-lock-mode 1748 (if (and (boundp 'font-lock-mode)
1749 font-lock-mode)
1522 (font-lock-fontify-buffer)) 1750 (font-lock-fontify-buffer))
1523 1751
1524 ;; Set the mode name to include the product. 1752 ;; Set the mode name to include the product.
@@ -1528,7 +1756,7 @@ selected."
1528 "Set `sql-product' to product and enable appropriate 1756 "Set `sql-product' to product and enable appropriate
1529highlighting." 1757highlighting."
1530 (interactive "SEnter SQL product: ") 1758 (interactive "SEnter SQL product: ")
1531 (when (not (assoc product sql-product-support)) 1759 (when (not (assoc product sql-product-alist))
1532 (error "SQL product %s is not supported; treated as ANSI" product) 1760 (error "SQL product %s is not supported; treated as ANSI" product)
1533 (setq product 'ansi)) 1761 (setq product 'ansi))
1534 1762
@@ -1952,6 +2180,19 @@ Every newline in STRING will be preceded with a space and a backslash."
1952 (interactive) 2180 (interactive)
1953 (sql-send-region (point-min) (point-max))) 2181 (sql-send-region (point-min) (point-max)))
1954 2182
2183(defun sql-send-string (str)
2184 "Send a string to the SQL process."
2185 (interactive "sSQL Text: ")
2186 (if (buffer-live-p sql-buffer)
2187 (save-excursion
2188 (comint-send-string sql-buffer str)
2189 (comint-send-string sql-buffer "\n")
2190 (message "Sent string to buffer %s." (buffer-name sql-buffer))
2191 (if sql-pop-to-buffer-after-send-region
2192 (pop-to-buffer sql-buffer)
2193 (display-buffer sql-buffer)))
2194 (message "No SQL process started.")))
2195
1955(defun sql-toggle-pop-to-buffer-after-send-region (&optional value) 2196(defun sql-toggle-pop-to-buffer-after-send-region (&optional value)
1956 "Toggle `sql-pop-to-buffer-after-send-region'. 2197 "Toggle `sql-pop-to-buffer-after-send-region'.
1957 2198
@@ -2611,6 +2852,8 @@ parameters and command options."
2611 (setq params (append params (list sql-database)))) 2852 (setq params (append params (list sql-database))))
2612 (if (not (string= "" sql-server)) 2853 (if (not (string= "" sql-server))
2613 (setq params (append (list "-h" sql-server) params))) 2854 (setq params (append (list "-h" sql-server) params)))
2855 (if (not (string= "" sql-user))
2856 (setq params (append (list "-U" sql-user) params)))
2614 (set-buffer (apply 'make-comint "SQL" sql-postgres-program 2857 (set-buffer (apply 'make-comint "SQL" sql-postgres-program
2615 nil params)))) 2858 nil params))))
2616 2859
diff --git a/lisp/simple.el b/lisp/simple.el
index 4f7786ef9a4..b557507fba1 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2148,7 +2148,8 @@ visual feedback indicating the extent of the region being copied."
2148 ;; look like a C-g typed as a command. 2148 ;; look like a C-g typed as a command.
2149 (inhibit-quit t)) 2149 (inhibit-quit t))
2150 (if (pos-visible-in-window-p other-end (selected-window)) 2150 (if (pos-visible-in-window-p other-end (selected-window))
2151 (unless transient-mark-mode 2151 (unless (and transient-mark-mode
2152 (face-background 'region))
2152 ;; Swap point and mark. 2153 ;; Swap point and mark.
2153 (set-marker (mark-marker) (point) (current-buffer)) 2154 (set-marker (mark-marker) (point) (current-buffer))
2154 (goto-char other-end) 2155 (goto-char other-end)
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index 8194a7d8e21..35903dcf749 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -65,7 +65,7 @@
65(defcustom smerge-diff-switches 65(defcustom smerge-diff-switches
66 (append '("-d" "-b") 66 (append '("-d" "-b")
67 (if (listp diff-switches) diff-switches (list diff-switches))) 67 (if (listp diff-switches) diff-switches (list diff-switches)))
68 "*A list of strings specifying switches to be be passed to diff. 68 "*A list of strings specifying switches to be passed to diff.
69Used in `smerge-diff-base-mine' and related functions." 69Used in `smerge-diff-base-mine' and related functions."
70 :group 'smerge 70 :group 'smerge
71 :type '(repeat string)) 71 :type '(repeat string))
@@ -324,7 +324,7 @@ according to `smerge-match-conflict'.")
324 ;; Out of range 324 ;; Out of range
325 (popup-menu smerge-mode-menu) 325 (popup-menu smerge-mode-menu)
326 ;; Install overlay. 326 ;; Install overlay.
327 (setq o (make-overlay (match-beginning i) (match-end i))) 327 (setq o (make-overlay (match-beginning i) (match-end i)))
328 (unwind-protect 328 (unwind-protect
329 (progn 329 (progn
330 (overlay-put o 'face 'highlight) 330 (overlay-put o 'face 'highlight)
@@ -512,7 +512,7 @@ An error is raised if not inside a conflict."
512 (unwind-protect 512 (unwind-protect
513 (add-text-properties start end smerge-text-properties) 513 (add-text-properties start end smerge-text-properties)
514 (restore-buffer-modified-p m))) 514 (restore-buffer-modified-p m)))
515 515
516 (store-match-data (list start end 516 (store-match-data (list start end
517 mine-start mine-end 517 mine-start mine-end
518 base-start base-end 518 base-start base-end
diff --git a/lisp/subr.el b/lisp/subr.el
index a9acc15606d..e81713ebf29 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1531,8 +1531,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
1531(defun remove-overlays (&optional beg end name val) 1531(defun remove-overlays (&optional beg end name val)
1532 "Clear BEG and END of overlays whose property NAME has value VAL. 1532 "Clear BEG and END of overlays whose property NAME has value VAL.
1533Overlays might be moved and or split. 1533Overlays might be moved and or split.
1534If BEG is nil, `(point-min)' is used. If END is nil, `(point-max)' 1534BEG and END default to the beginning resp. end of buffer."
1535is used."
1536 (unless beg (setq beg (point-min))) 1535 (unless beg (setq beg (point-min)))
1537 (unless end (setq end (point-max))) 1536 (unless end (setq end (point-max)))
1538 (if (< end beg) 1537 (if (< end beg)
diff --git a/lisp/xml.el b/lisp/xml.el
index ab87125356d..db3292a4cfb 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -622,9 +622,15 @@ This follows the rule [28] in the XML specifications."
622;;** 622;;**
623;;******************************************************************* 623;;*******************************************************************
624 624
625(defun xml-debug-print (xml) 625(defun xml-debug-print (xml &optional indent-string)
626 "Outputs the XML in the current buffer.
627XML can be a tree or a list of nodes.
628The first line is indented with the optional INDENT-STRING."
629 (setq indent-string (or indent-string ""))
626 (dolist (node xml) 630 (dolist (node xml)
627 (xml-debug-print-internal node ""))) 631 (xml-debug-print-internal node indent-string)))
632
633(defalias 'xml-print 'xml-debug-print)
628 634
629(defun xml-debug-print-internal (xml indent-string) 635(defun xml-debug-print-internal (xml indent-string)
630 "Outputs the XML tree in the current buffer. 636 "Outputs the XML tree in the current buffer.
@@ -639,22 +645,26 @@ The first line is indented with INDENT-STRING."
639 (insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\") 645 (insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\")
640 (setq attlist (cdr attlist))) 646 (setq attlist (cdr attlist)))
641 647
642 (insert ?>)
643
644 (setq tree (xml-node-children tree)) 648 (setq tree (xml-node-children tree))
645 649
646 ;; output the children 650 (if (null tree)
647 (dolist (node tree) 651 (insert ?/ ?>)
648 (cond 652 (insert ?>)
649 ((listp node) 653
650 (insert ?\n) 654 ;; output the children
651 (xml-debug-print-internal node (concat indent-string " "))) 655 (dolist (node tree)
652 ((stringp node) (insert node)) 656 (cond
653 (t 657 ((listp node)
654 (error "Invalid XML tree")))) 658 (insert ?\n)
655 659 (xml-debug-print-internal node (concat indent-string " ")))
656 (insert ?\n indent-string 660 ((stringp node) (insert node))
657 ?< ?/ (symbol-name (xml-node-name xml)) ?>))) 661 (t
662 (error "Invalid XML tree"))))
663
664 (when (not (and (null (cdr tree))
665 (stringp (car tree))))
666 (insert ?\n indent-string))
667 (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>))))
658 668
659(provide 'xml) 669(provide 'xml)
660 670