aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/progmodes
diff options
context:
space:
mode:
authorPaul Eggert2012-03-01 18:29:30 -0800
committerPaul Eggert2012-03-01 18:29:30 -0800
commit9d6b4d53469a9ffd67bd770fabc6fe254e35c21d (patch)
treede238c6f707915be9ed1f10235589b4e975a08fb /lisp/progmodes
parenta89654f8f34114db543cb91363e8fded6d73e986 (diff)
parenteec1549a6b89359b6d970f14dead275e59b7bc6f (diff)
downloademacs-9d6b4d53469a9ffd67bd770fabc6fe254e35c21d.tar.gz
emacs-9d6b4d53469a9ffd67bd770fabc6fe254e35c21d.zip
Merge from trunk.
Diffstat (limited to 'lisp/progmodes')
-rw-r--r--lisp/progmodes/antlr-mode.el8
-rw-r--r--lisp/progmodes/gdb-mi.el18
-rw-r--r--lisp/progmodes/sql.el187
-rw-r--r--lisp/progmodes/vhdl-mode.el6
4 files changed, 120 insertions, 99 deletions
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 634570cf3e4..9c9a8e09d49 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,6 +1,6 @@
1;;; antlr-mode.el --- major mode for ANTLR grammar files 1;;; antlr-mode.el --- major mode for ANTLR grammar files
2 2
3;; Copyright (C) 1999-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
4 4
5;; Author: Christoph.Wedler@sap.com 5;; Author: Christoph.Wedler@sap.com
6;; Keywords: languages, ANTLR, code generator 6;; Keywords: languages, ANTLR, code generator
@@ -961,7 +961,7 @@ group. The string matched by the first group is highlighted with
961 (antlr-re-search-forward 961 (antlr-re-search-forward
962 "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" 962 "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
963 limit)) 963 limit))
964 (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad 964 (1 font-lock-type-face) ; not XEmacs's java level-3 fruit salad
965 (3 (if (antlr-upcase-p (char-after (match-beginning 3))) 965 (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
966 antlr-tokendef-face 966 antlr-tokendef-face
967 antlr-ruledef-face) nil t) 967 antlr-ruledef-face) nil t)
@@ -1030,7 +1030,7 @@ not to confuse their context_cache.")
1030(define-abbrev-table 'antlr-mode-abbrev-table ()) 1030(define-abbrev-table 'antlr-mode-abbrev-table ())
1031 1031
1032(defvar antlr-slow-cache-enabling-symbol 'loudly 1032(defvar antlr-slow-cache-enabling-symbol 'loudly
1033;; Emacs' font-lock changes buffer's tick counter, therefore this value should 1033;; Emacs's font-lock changes buffer's tick counter, therefore this value should
1034;; be a parameter of a font-lock function, but not any other variable of 1034;; be a parameter of a font-lock function, but not any other variable of
1035;; functions which call `antlr-slow-syntactic-context'. 1035;; functions which call `antlr-slow-syntactic-context'.
1036 "If value is a bound symbol, cache will be used even with text changes. 1036 "If value is a bound symbol, cache will be used even with text changes.
@@ -1113,7 +1113,7 @@ WARNING: this may alter `match-data'."
1113 (or (buffer-syntactic-context) (buffer-syntactic-context-depth)) 1113 (or (buffer-syntactic-context) (buffer-syntactic-context-depth))
1114 :EMACS 1114 :EMACS
1115 (let ((orig (point)) diff state 1115 (let ((orig (point)) diff state
1116 ;; Arg, Emacs' (buffer-modified-tick) changes with font-lock. Use 1116 ;; Arg, Emacs's (buffer-modified-tick) changes with font-lock. Use
1117 ;; hack that `loudly' is bound during font-locking => cache use will 1117 ;; hack that `loudly' is bound during font-locking => cache use will
1118 ;; increase from 7% to 99.99% during font-locking. 1118 ;; increase from 7% to 99.99% during font-locking.
1119 (tick (or (boundp antlr-slow-cache-enabling-symbol) 1119 (tick (or (boundp antlr-slow-cache-enabling-symbol)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 301714ec55f..0c45c3f5e5d 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1672,8 +1672,6 @@ static char *magick[] = {
1672 (if (not (string= "" string)) 1672 (if (not (string= "" string))
1673 (setq gdb-last-command string) 1673 (setq gdb-last-command string)
1674 (if gdb-last-command (setq string gdb-last-command))) 1674 (if gdb-last-command (setq string gdb-last-command)))
1675 (if gdb-enable-debug
1676 (push (cons 'mi-send (concat string "\n")) gdb-debug-log))
1677 (if (string-match "^-" string) 1675 (if (string-match "^-" string)
1678 ;; MI command 1676 ;; MI command
1679 (progn 1677 (progn
@@ -1683,10 +1681,22 @@ static char *magick[] = {
1683 (if (string-match "\\\\$" string) 1681 (if (string-match "\\\\$" string)
1684 (setq gdb-continuation (concat gdb-continuation string "\n")) 1682 (setq gdb-continuation (concat gdb-continuation string "\n"))
1685 (setq gdb-first-done-or-error t) 1683 (setq gdb-first-done-or-error t)
1686 (process-send-string proc (concat "-interpreter-exec console \"" 1684 (let ((to-send (concat "-interpreter-exec console "
1687 gdb-continuation string "\"\n")) 1685 (gdb-mi-quote string)
1686 "\n")))
1687 (if gdb-enable-debug
1688 (push (cons 'mi-send to-send) gdb-debug-log))
1689 (process-send-string proc to-send))
1688 (setq gdb-continuation nil)))) 1690 (setq gdb-continuation nil))))
1689 1691
1692(defun gdb-mi-quote (string)
1693 "Return STRING quoted properly as an MI argument.
1694The string is enclosed in double quotes.
1695All embedded quotes, newlines, and backslashes are preceded with a backslash."
1696 (setq string (replace-regexp-in-string "\\([\"\\]\\)" "\\\\\\&" string))
1697 (setq string (replace-regexp-in-string "\n" "\\n" string t t))
1698 (concat "\"" string "\""))
1699
1690(defun gdb-input (command handler-function) 1700(defun gdb-input (command handler-function)
1691 "Send COMMAND to GDB via the MI interface. 1701 "Send COMMAND to GDB via the MI interface.
1692Run the function HANDLER-FUNCTION, with no arguments, once the command is 1702Run the function HANDLER-FUNCTION, with no arguments, once the command is
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index f5bfe526aae..56f42e31cf1 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2853,9 +2853,12 @@ appended to the SQLi buffer without disturbing your SQL buffer."
2853 "Read a password using PROMPT. Optional DEFAULT is password to start with." 2853 "Read a password using PROMPT. Optional DEFAULT is password to start with."
2854 (read-passwd prompt nil default)) 2854 (read-passwd prompt nil default))
2855 2855
2856(defun sql-get-login-ext (prompt last-value history-var plist) 2856(defun sql-get-login-ext (symbol prompt history-var plist)
2857 "Prompt user with extended login parameters. 2857 "Prompt user with extended login parameters.
2858 2858
2859The global value of SYMBOL is the last value and the global value
2860of the SYMBOL is set based on the user's input.
2861
2859If PLIST is nil, then the user is simply prompted for a string 2862If PLIST is nil, then the user is simply prompted for a string
2860value. 2863value.
2861 2864
@@ -2868,38 +2871,41 @@ regexp pattern specified in its value.
2868The `:completion' property prompts for a string specified by its 2871The `:completion' property prompts for a string specified by its
2869value. (The property value is used as the PREDICATE argument to 2872value. (The property value is used as the PREDICATE argument to
2870`completing-read'.)" 2873`completing-read'.)"
2871 (let* ((default (plist-get plist :default)) 2874 (set-default
2872 (prompt-def 2875 symbol
2873 (if default 2876 (let* ((default (plist-get plist :default))
2874 (if (string-match "\\(\\):[ \t]*\\'" prompt) 2877 (last-value (default-value symbol))
2875 (replace-match (format " (default \"%s\")" default) t t prompt 1) 2878 (prompt-def
2876 (replace-regexp-in-string "[ \t]*\\'" 2879 (if default
2877 (format " (default \"%s\") " default) 2880 (if (string-match "\\(\\):[ \t]*\\'" prompt)
2878 prompt t t)) 2881 (replace-match (format " (default \"%s\")" default) t t prompt 1)
2879 prompt)) 2882 (replace-regexp-in-string "[ \t]*\\'"
2880 (use-dialog-box nil)) 2883 (format " (default \"%s\") " default)
2881 (cond 2884 prompt t t))
2882 ((plist-member plist :file) 2885 prompt))
2883 (expand-file-name 2886 (use-dialog-box nil))
2884 (read-file-name prompt 2887 (cond
2885 (file-name-directory last-value) default t 2888 ((plist-member plist :file)
2886 (file-name-nondirectory last-value) 2889 (expand-file-name
2887 (when (plist-get plist :file) 2890 (read-file-name prompt
2888 `(lambda (f) 2891 (file-name-directory last-value) default t
2889 (string-match 2892 (file-name-nondirectory last-value)
2890 (concat "\\<" ,(plist-get plist :file) "\\>") 2893 (when (plist-get plist :file)
2891 (file-name-nondirectory f))))))) 2894 `(lambda (f)
2892 2895 (string-match
2893 ((plist-member plist :completion) 2896 (concat "\\<" ,(plist-get plist :file) "\\>")
2894 (completing-read prompt-def (plist-get plist :completion) nil t 2897 (file-name-nondirectory f)))))))
2895 last-value history-var default)) 2898
2896 2899 ((plist-member plist :completion)
2897 ((plist-get plist :number) 2900 (completing-read prompt-def (plist-get plist :completion) nil t
2898 (read-number prompt (or default last-value 0))) 2901 last-value history-var default))
2899 2902
2900 (t 2903 ((plist-get plist :number)
2901 (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) 2904 (read-number prompt (or default last-value 0)))
2902 (if (string= "" r) (or default "") r)))))) 2905
2906 (t
2907 (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil)))
2908 (if (string= "" r) (or default "") r)))))))
2903 2909
2904(defun sql-get-login (&rest what) 2910(defun sql-get-login (&rest what)
2905 "Get username, password and database from the user. 2911 "Get username, password and database from the user.
@@ -2937,28 +2943,20 @@ function like this: (sql-get-login 'user 'password 'database)."
2937 2943
2938 (cond 2944 (cond
2939 ((eq token 'user) ; user 2945 ((eq token 'user) ; user
2940 (setq sql-user 2946 (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
2941 (sql-get-login-ext "User: " sql-user
2942 'sql-user-history plist)))
2943 2947
2944 ((eq token 'password) ; password 2948 ((eq token 'password) ; password
2945 (setq sql-password 2949 (setq-default sql-password
2946 (sql-read-passwd "Password: " sql-password))) 2950 (sql-read-passwd "Password: " sql-password)))
2947 2951
2948 ((eq token 'server) ; server 2952 ((eq token 'server) ; server
2949 (setq sql-server 2953 (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
2950 (sql-get-login-ext "Server: " sql-server
2951 'sql-server-history plist)))
2952 2954
2953 ((eq token 'database) ; database 2955 ((eq token 'database) ; database
2954 (setq sql-database 2956 (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist))
2955 (sql-get-login-ext "Database: " sql-database
2956 'sql-database-history plist)))
2957 2957
2958 ((eq token 'port) ; port 2958 ((eq token 'port) ; port
2959 (setq sql-port 2959 (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist))))))
2960 (sql-get-login-ext "Port: " sql-port
2961 nil (append '(:number t) plist)))))))
2962 what)) 2960 what))
2963 2961
2964(defun sql-find-sqli-buffer (&optional product connection) 2962(defun sql-find-sqli-buffer (&optional product connection)
@@ -3841,6 +3839,7 @@ you entered, right above the output it created.
3841 (set (make-local-variable 'sql-server) sql-server) 3839 (set (make-local-variable 'sql-server) sql-server)
3842 (set (make-local-variable 'sql-port) sql-port) 3840 (set (make-local-variable 'sql-port) sql-port)
3843 (set (make-local-variable 'sql-connection) sql-connection) 3841 (set (make-local-variable 'sql-connection) sql-connection)
3842 (setq-default sql-connection nil)
3844 ;; Contains the name of database objects 3843 ;; Contains the name of database objects
3845 (set (make-local-variable 'sql-contains-names) t) 3844 (set (make-local-variable 'sql-contains-names) t)
3846 ;; Keep track of existing object names 3845 ;; Keep track of existing object names
@@ -3935,43 +3934,50 @@ is specified in the connection settings."
3935 ;; Settings are defined 3934 ;; Settings are defined
3936 (if connect-set 3935 (if connect-set
3937 ;; Set the desired parameters 3936 ;; Set the desired parameters
3938 (eval `(let* 3937 (let (param-var login-params set-params rem-params)
3939 (,@(cdr connect-set) 3938
3940 ;; :sqli-login params variable 3939 ;; :sqli-login params variable
3941 (param-var (sql-get-product-feature sql-product 3940 (setq param-var
3942 :sqli-login nil t)) 3941 (sql-get-product-feature sql-product :sqli-login nil t))
3943 ;; :sqli-login params value 3942
3944 (login-params (sql-get-product-feature sql-product 3943 ;; :sqli-login params value
3945 :sqli-login)) 3944 (setq login-params
3946 ;; which params are in the connection 3945 (sql-get-product-feature sql-product :sqli-login))
3947 (set-params (mapcar 3946
3948 (lambda (v) 3947 ;; Params in the connection
3949 (cond 3948 (setq set-params
3950 ((eq (car v) 'sql-user) 'user) 3949 (mapcar
3951 ((eq (car v) 'sql-password) 'password) 3950 (lambda (v)
3952 ((eq (car v) 'sql-server) 'server) 3951 (cond
3953 ((eq (car v) 'sql-database) 'database) 3952 ((eq (car v) 'sql-user) 'user)
3954 ((eq (car v) 'sql-port) 'port) 3953 ((eq (car v) 'sql-password) 'password)
3955 (t (car v)))) 3954 ((eq (car v) 'sql-server) 'server)
3956 (cdr connect-set))) 3955 ((eq (car v) 'sql-database) 'database)
3957 ;; the remaining params (w/o the connection params) 3956 ((eq (car v) 'sql-port) 'port)
3958 (rem-params (sql-for-each-login 3957 (t (car v))))
3959 login-params 3958 (cdr connect-set)))
3960 (lambda (token plist) 3959
3961 (unless (member token set-params) 3960 ;; the remaining params (w/o the connection params)
3962 (if plist 3961 (setq rem-params
3963 (cons token plist) 3962 (sql-for-each-login login-params
3964 token)))))) 3963 (lambda (token plist)
3965 3964 (unless (member token set-params)
3966 ;; Set the remaining parameters and start the 3965 (if plist (cons token plist) token)))))
3967 ;; interactive session 3966
3968 (eval `(let ((sql-connection ,connection) 3967 ;; Set the parameters and start the interactive session
3969 (,param-var ',rem-params)) 3968 (mapc
3970 (sql-product-interactive sql-product 3969 (lambda (vv)
3971 new-name))))) 3970 (set-default (car vv) (eval (cadr vv))))
3971 (cdr connect-set))
3972 (setq-default sql-connection connection)
3973
3974 ;; Start the SQLi session with revised list of login parameters
3975 (eval `(let ((,param-var ',rem-params))
3976 (sql-product-interactive sql-product new-name))))
3972 3977
3973 (message "SQL Connection <%s> does not exist" connection) 3978 (message "SQL Connection <%s> does not exist" connection)
3974 nil))) 3979 nil)))
3980
3975 (message "No SQL Connections defined") 3981 (message "No SQL Connections defined")
3976 nil)) 3982 nil))
3977 3983
@@ -4101,9 +4107,14 @@ the call to \\[sql-product-interactive] with
4101 4107
4102 ;; Connect to database. 4108 ;; Connect to database.
4103 (message "Login...") 4109 (message "Login...")
4104 (funcall (sql-get-product-feature product :sqli-comint-func) 4110 (let ((sql-user (default-value 'sql-user))
4105 product 4111 (sql-password (default-value 'sql-password))
4106 (sql-get-product-feature product :sqli-options)) 4112 (sql-server (default-value 'sql-server))
4113 (sql-database (default-value 'sql-database))
4114 (sql-port (default-value 'sql-port)))
4115 (funcall (sql-get-product-feature product :sqli-comint-func)
4116 product
4117 (sql-get-product-feature product :sqli-options)))
4107 4118
4108 ;; Set SQLi mode. 4119 ;; Set SQLi mode.
4109 (let ((sql-interactive-product product)) 4120 (let ((sql-interactive-product product))
@@ -4113,7 +4124,7 @@ the call to \\[sql-product-interactive] with
4113 (setq new-sqli-buffer (current-buffer)) 4124 (setq new-sqli-buffer (current-buffer))
4114 (when new-name 4125 (when new-name
4115 (sql-rename-buffer new-name)) 4126 (sql-rename-buffer new-name))
4116 (set (make-local-variable 'sql-buffer) 4127 (set (make-local-variable 'sql-buffer)
4117 (buffer-name new-sqli-buffer)) 4128 (buffer-name new-sqli-buffer))
4118 4129
4119 ;; Set `sql-buffer' in the start buffer 4130 ;; Set `sql-buffer' in the start buffer
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index d765a960470..c9bf638bb59 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,6 +1,6 @@
1;;; vhdl-mode.el --- major mode for editing VHDL code 1;;; vhdl-mode.el --- major mode for editing VHDL code
2 2
3;; Copyright (C) 1992-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
4 4
5;; Authors: Reto Zimmermann <reto@gnu.org> 5;; Authors: Reto Zimmermann <reto@gnu.org>
6;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net> 6;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
@@ -2040,7 +2040,7 @@ Ignore byte-compiler warnings you might see."
2040;; `wildcard-to-regexp' is included only in XEmacs 21 2040;; `wildcard-to-regexp' is included only in XEmacs 21
2041(unless (fboundp 'wildcard-to-regexp) 2041(unless (fboundp 'wildcard-to-regexp)
2042 (defun wildcard-to-regexp (wildcard) 2042 (defun wildcard-to-regexp (wildcard)
2043 "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'." 2043 "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'."
2044 (let* ((i (string-match "[*?]" wildcard)) 2044 (let* ((i (string-match "[*?]" wildcard))
2045 (result (substring wildcard 0 i)) 2045 (result (substring wildcard 0 i))
2046 (len (length wildcard))) 2046 (len (length wildcard)))
@@ -2087,7 +2087,7 @@ Ignore byte-compiler warnings you might see."
2087;; `file-expand-wildcards' undefined (XEmacs) 2087;; `file-expand-wildcards' undefined (XEmacs)
2088(unless (fboundp 'file-expand-wildcards) 2088(unless (fboundp 'file-expand-wildcards)
2089 (defun file-expand-wildcards (pattern &optional full) 2089 (defun file-expand-wildcards (pattern &optional full)
2090 "Taken from Emacs' `files.el'." 2090 "Taken from Emacs's `files.el'."
2091 (let* ((nondir (file-name-nondirectory pattern)) 2091 (let* ((nondir (file-name-nondirectory pattern))
2092 (dirpart (file-name-directory pattern)) 2092 (dirpart (file-name-directory pattern))
2093 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 2093 (dirs (if (and dirpart (string-match "[[*?]" dirpart))