diff options
Diffstat (limited to 'lisp/progmodes')
| -rw-r--r-- | lisp/progmodes/cc-engine.el | 58 | ||||
| -rw-r--r-- | lisp/progmodes/cc-mode.el | 2 | ||||
| -rw-r--r-- | lisp/progmodes/cc-vars.el | 4 | ||||
| -rw-r--r-- | lisp/progmodes/sql.el | 193 |
4 files changed, 222 insertions, 35 deletions
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 071efbc55b5..27ce3029c4a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1732,6 +1732,7 @@ comment at the start of cc-engine.el for more info." (put-text-property beg end 'c-is-sws t) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-add-face beg end 'c-debug-is-sws-face))))) +(def-edebug-spec c-put-is-sws t) (defmacro c-put-in-sws (beg end) ;; This macro does a hidden buffer change. @@ -1739,6 +1740,7 @@ comment at the start of cc-engine.el for more info." (put-text-property beg end 'c-in-sws t) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-add-face beg end 'c-debug-in-sws-face))))) +(def-edebug-spec c-put-in-sws t) (defmacro c-remove-is-sws (beg end) ;; This macro does a hidden buffer change. @@ -1746,6 +1748,7 @@ comment at the start of cc-engine.el for more info." (remove-text-properties beg end '(c-is-sws nil)) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-is-sws-face))))) +(def-edebug-spec c-remove-is-sws t) (defmacro c-remove-in-sws (beg end) ;; This macro does a hidden buffer change. @@ -1753,6 +1756,7 @@ comment at the start of cc-engine.el for more info." (remove-text-properties beg end '(c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-in-sws-face))))) +(def-edebug-spec c-remove-in-sws t) (defmacro c-remove-is-and-in-sws (beg end) ;; This macro does a hidden buffer change. @@ -1761,6 +1765,7 @@ comment at the start of cc-engine.el for more info." ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-is-sws-face) (c-debug-remove-face beg end 'c-debug-in-sws-face))))) +(def-edebug-spec c-remove-is-and-in-sws t) ;; The type of literal position `end' is in a `before-change-functions' ;; function - one of `c', `c++', `pound', or nil (but NOT `string'). @@ -1769,12 +1774,14 @@ comment at the start of cc-engine.el for more info." ;; enclosing END, if any, else nil. (defvar c-sws-lit-limits nil) -(defun c-invalidate-sws-region-before (end) - ;; Called from c-before-change. END is the end of the change region, the - ;; standard parameter given to all before-change-functions. +(defun c-invalidate-sws-region-before (beg end) + ;; Called from c-before-change. BEG and END are the bounds of the change + ;; region, the standard parameters given to all before-change-functions. ;; - ;; Note whether END is inside a comment or CPP construct, and if so note its - ;; bounds in `c-sws-lit-limits' and type in `c-sws-lit-type'. + ;; Note whether END is inside a comment, CPP construct, or noise macro, and + ;; if so note its bounds in `c-sws-lit-limits' and type in `c-sws-lit-type'. + (setq c-sws-lit-type nil + c-sws-lit-limits nil) (save-excursion (goto-char end) (let* ((limits (c-literal-limits)) @@ -1787,8 +1794,19 @@ comment at the start of cc-engine.el for more info." (setq c-sws-lit-type 'pound c-sws-lit-limits (cons (point) (progn (c-end-of-macro) (point))))) - (t (setq c-sws-lit-type nil - c-sws-lit-limits nil)))))) + ((progn (skip-syntax-backward "w_") + (looking-at c-noise-macro-name-re)) + (setq c-sws-lit-type 'noise + c-sws-lit-limits (cons (match-beginning 1) (match-end 1)))) + (t)))) + (save-excursion + (goto-char beg) + (skip-syntax-backward "w_") + (when (looking-at c-noise-macro-name-re) + (setq c-sws-lit-type 'noise) + (if (consp c-sws-lit-limits) + (setcar c-sws-lit-limits (match-beginning 1)) + (setq c-sws-lit-limits (cons (match-beginning 1) (match-end 1))))))) (defun c-invalidate-sws-region-after-del (beg end old-len) ;; Text has been deleted, OLD-LEN characters of it starting from position @@ -1797,7 +1815,6 @@ comment at the start of cc-engine.el for more info." ;; deletion deleted or "damaged" its opening delimiter. If so, return the ;; current position of where the construct ended, otherwise return nil. (when c-sws-lit-limits - (setcdr c-sws-lit-limits (- (cdr c-sws-lit-limits) old-len)) (if (and (< beg (+ (car c-sws-lit-limits) 2)) ; A lazy assumption that ; comment delimiters are 2 ; chars long. @@ -1815,9 +1832,9 @@ comment at the start of cc-engine.el for more info." ;; or `c-is-sws' text properties inside this literal. If there are, return ;; the buffer position of the end of the literal, else return nil. (save-excursion + (goto-char end) (let* ((limits (c-literal-limits)) (lit-type (c-literal-type limits))) - (goto-char end) (when (and (not (memq lit-type '(c c++))) (c-beginning-of-macro)) (setq lit-type 'pound @@ -1841,6 +1858,10 @@ comment at the start of cc-engine.el for more info." ;; properties right after they're added. ;; ;; This function does hidden buffer changes. + (when c-sws-lit-limits + (setcar c-sws-lit-limits (min beg (car c-sws-lit-limits))) + (setcdr c-sws-lit-limits + (max end (- (+ (cdr c-sws-lit-limits) (- end beg)) old-len)))) (let ((del-end (and (> old-len 0) (c-invalidate-sws-region-after-del beg end old-len))) @@ -1860,6 +1881,10 @@ comment at the start of cc-engine.el for more info." (when (and (eolp) (not (eobp))) (setq end (1+ (point))))) + (when (eq c-sws-lit-type 'noise) + (setq beg (car c-sws-lit-limits) + end (cdr c-sws-lit-limits))) ; This last setting may be redundant. + (when (and (= beg end) (get-text-property beg 'c-in-sws) (> beg (point-min)) @@ -1879,6 +1904,7 @@ comment at the start of cc-engine.el for more info." (setq end (max (or del-end end) (or ins-end end) + (or (cdr c-sws-lit-limits) end) end)) (c-debug-sws-msg "c-invalidate-sws-region-after [%s..%s]" beg end) @@ -2147,7 +2173,8 @@ comment at the start of cc-engine.el for more info." ;; Try to find a rung position in the simple ws preceding point, so that ;; we can get a cache hit even if the last bit of the simple ws has ;; changed recently. - (setq simple-ws-beg (point)) + (setq simple-ws-beg (or (match-end 1) ; Noise macro + (match-end 0))) ; c-syntactic-ws-end (skip-chars-backward " \t\n\r\f\v") (if (setq rung-is-marked (text-property-any (point) (min (1+ rung-pos) (point-max)) @@ -8672,7 +8699,16 @@ comment at the start of cc-engine.el for more info." (not (and (c-major-mode-is 'c-mode) (not got-prefix) (or (eq context 'top) make-top) - (eq (char-after) ?\))))) + (eq (char-after) ?\)) + (or (memq at-type '(nil maybe)) + (not got-identifier) + (save-excursion + (goto-char after-paren-pos) + (c-forward-syntactic-ws) + ;; Prevent the symbol being recorded as a type. + (let (c-record-type-identifiers) + (not (memq (c-forward-type) + '(nil maybe))))))))) (if (eq (char-after) ?\)) (when (> paren-depth 0) (setq paren-depth (1- paren-depth)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index a2ad07fddb0..6718813b79c 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1623,7 +1623,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"? (when (< beg end) (c-unfind-coalesced-tokens beg end)) - (c-invalidate-sws-region-before end) + (c-invalidate-sws-region-before beg end) ;; Are we (potentially) disrupting the syntactic context which ;; makes a type a type? E.g. by inserting stuff after "foo" in ;; "foo bar;", or before "foo" in "typedef foo *bar;"? diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 66960b630e1..89534882672 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1649,7 +1649,9 @@ white space either before or after the operator, but not both." ;; Initialize the next two to a regexp which never matches. (defvar c-noise-macro-with-parens-name-re "a\\`") +(make-variable-buffer-local 'c-noise-macro-with-parens-name-re) (defvar c-noise-macro-name-re "a\\`") +(make-variable-buffer-local 'c-noise-macro-name-re) (defcustom c-noise-macro-names nil "A list of names of macros which expand to nothing, or compiler extensions @@ -1664,6 +1666,7 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)." :type '(repeat :tag "List of names" string) :group 'c) (put 'c-noise-macro-names 'safe-local-variable #'c-string-list-p) +(make-variable-buffer-local 'c-noise-macro-names) (defcustom c-noise-macro-with-parens-names nil "A list of names of macros \(or compiler extensions like \"__attribute__\") @@ -1673,6 +1676,7 @@ These are recognized by CC Mode only in declarations." :type '(repeat :tag "List of names (possibly empty)" string) :group 'c) (put 'c-noise-macro-with-parens-names 'safe-local-variable #'c-string-list-p) +(make-variable-buffer-local 'c-noise-macro-with-parens-names) (defun c-make-noise-macro-regexps () ;; Convert `c-noise-macro-names' and `c-noise-macro-with-parens-names' into diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6ad221295ca..9bae3d86640 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -237,6 +237,7 @@ (require 'custom) (require 'thingatpt) (require 'view) +(eval-when-compile (require 'subr-x)) ; string-empty-p (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -738,16 +739,131 @@ The package must be available to be loaded and activated." :type 'booleanp :version "27.1") -(defun sql-is-indent-available () - "Check if sql-indent module is available." - (when (locate-library "sql-indent") - (fboundp 'sqlind-minor-mode))) - (defun sql-indent-enable () "Enable `sqlind-minor-mode' if available and requested." - (when (sql-is-indent-available) + (when (fboundp 'sqlind-minor-mode) (sqlind-minor-mode (if sql-use-indent-support +1 -1)))) +;; Secure Password wallet + +(require 'auth-source) + +(defun sql-auth-source-search-wallet (wallet product user server database port) + "Read auth source WALLET to locate the USER secret. +Sets `auth-sources' to WALLET and uses `auth-source-search' to locate the entry. +The DATABASE and SERVER are concatenated with a slash between them as the +host key." + (let* ((auth-sources wallet) + host + secret h-secret sd-secret) + + ;; product + (setq product (symbol-name product)) + + ;; user + (setq user (unless (string-empty-p user) user)) + + ;; port + (setq port + (when (and port (numberp port) (not (zerop port))) + (number-to-string port))) + + ;; server + (setq server (unless (string-empty-p server) server)) + + ;; database + (setq database (unless (string-empty-p database) database)) + + ;; host + (setq host (if server + (if database + (concat server "/" database) + server) + database)) + + ;; Perform search + (dolist (s (auth-source-search :max 1000)) + (when (and + ;; Is PRODUCT specified, in the enty, and they are equal + (if product + (if (plist-member s :product) + (equal (plist-get s :product) product) + t) + t) + ;; Is USER specified, in the entry, and they are equal + (if user + (if (plist-member s :user) + (equal (plist-get s :user) user) + t) + t) + ;; Is PORT specified, in the entry, and they are equal + (if port + (if (plist-member s :port) + (equal (plist-get s :port) port) + t) + t)) + ;; Is HOST specified, in the entry, and they are equal + ;; then the H-SECRET list + (if (and host + (plist-member s :host) + (equal (plist-get s :host) host)) + (push s h-secret) + ;; Are SERVER and DATABASE specified, present, and equal + ;; then the SD-SECRET list + (if (and server + (plist-member s :server) + database + (plist-member s :database) + (equal (plist-get s :server) server) + (equal (plist-get s :database) database)) + (push s sd-secret) + ;; Is SERVER specified, in the entry, and they are equal + ;; then the base SECRET list + (if (and server + (plist-member s :server) + (equal (plist-get s :server) server)) + (push s secret) + ;; Is DATABASE specified, in the entry, and they are equal + ;; then the base SECRET list + (if (and database + (plist-member s :database) + (equal (plist-get s :database) database)) + (push s secret))))))) + (setq secret (or h-secret sd-secret secret)) + + ;; If we found a single secret, return the password + (when (= 1 (length secret)) + (setq secret (car secret)) + (if (plist-member secret :secret) + (plist-get secret :secret) + nil)))) + +(defcustom sql-password-wallet + (let (wallet w) + (dolist (ext '(".json.gpg" ".gpg" ".json" "") wallet) + (unless wallet + (setq w (locate-user-emacs-file (concat "sql-wallet" ext) + (concat ".sql-wallet" ext))) + (when (file-exists-p w) + (setq wallet w))))) + "Identification of the password wallet. +See `sql-password-search-wallet-function' to understand how this value +is used to locate the password wallet." + :type `(plist-get (symbol-plist 'auth-sources) 'custom-type) + :group 'SQL + :version "27.1") + +(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet + "Function to handle the lookup of the database password. +The specified function will be called as: + (wallet-func WALLET PRODUCT USER SERVER DATABASE PORT) + +It is expected to return either a string containing the password, +a function returning the password, or nil, If you want to support +another format of password file, then implement a different +search wallet function and identify the location of the password +store with `sql-password-wallet'.") + ;; misc customization of sql.el behavior (defcustom sql-electric-stuff nil @@ -804,7 +920,7 @@ Globally should be set to nil; it will be non-nil in `sql-mode', (defvaralias 'sql-pop-to-buffer-after-send-region 'sql-display-sqli-buffer-function) -(defcustom sql-display-sqli-buffer-function 'display-buffer +(defcustom sql-display-sqli-buffer-function #'display-buffer "Function to be called to display a SQLi buffer after `sql-send-*'. When set to a function, it will be called to display the buffer. @@ -2929,7 +3045,7 @@ displayed." ;;; Motion Functions (defun sql-statement-regexp (prod) - (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement)) + (let* ((ansi-stmt (or (sql-get-product-feature 'ansi :statement) "select")) (prod-stmt (sql-get-product-feature prod :statement))) (concat "^\\<" (if prod-stmt @@ -3199,6 +3315,10 @@ symbol `password', for the server if it contains the symbol `database'. The members of WHAT are processed in the order in which they are provided. +If the `sql-password-wallet' is non-nil and WHAT contains the +`password' token, then the `password' token will be pushed to the +end to be sure that all of the values can be fed to the wallet. + Each token may also be a list with the token in the car and a plist of options as the cdr. The following properties are supported: @@ -3210,6 +3330,15 @@ supported: In order to ask the user for username, password and database, call the function like this: (sql-get-login \\='user \\='password \\='database)." + + ;; Push the password to the end if we have a wallet + (when (and sql-password-wallet + (fboundp sql-password-search-wallet-function) + (member 'password what)) + (setq what (append (cl-delete 'password what) + '(password)))) + + ;; Prompt for each parameter (dolist (w what) (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) @@ -3218,7 +3347,19 @@ function like this: (sql-get-login \\='user \\='password \\='database)." ('password (setq-default sql-password - (read-passwd "Password: " nil (sql-default-value 'sql-password)))) + (if (and sql-password-wallet + (fboundp sql-password-search-wallet-function)) + (let ((password (funcall sql-password-search-wallet-function + sql-password-wallet + sql-product + sql-user + sql-server + sql-database + sql-port))) + (if password + password + (read-passwd "Password: " nil (sql-default-value 'sql-password)))) + (read-passwd "Password: " nil (sql-default-value 'sql-password))))) ('server (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) @@ -3535,8 +3676,8 @@ Allows the suppression of continuation prompts.") ;; Count how many newlines in the string (setq sql-output-newline-count - (apply #'+ (mapcar (lambda (ch) - (if (eq ch ?\n) 1 0)) string))) + (apply #'+ (mapcar (lambda (ch) (if (eq ch ?\n) 1 0)) + string))) ;; Send the string (comint-simple-send proc string))) @@ -4086,7 +4227,7 @@ must tell Emacs. Here's how to do that in your init file: ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 - (add-hook 'hack-local-variables-hook 'sql-highlight-product t t)) + (add-hook 'hack-local-variables-hook #'sql-highlight-product t t)) @@ -4094,7 +4235,7 @@ must tell Emacs. Here's how to do that in your init file: (put 'sql-interactive-mode 'mode-class 'special) (put 'sql-interactive-mode 'custom-mode-group 'SQL) - +;; FIXME: Why not use `define-derived-mode'? (defun sql-interactive-mode () "Major mode to use a SQL interpreter interactively. @@ -4156,13 +4297,15 @@ certain length. \(add-hook \\='sql-interactive-mode-hook (function (lambda () - (setq comint-output-filter-functions \\='comint-truncate-buffer)))) + (setq comint-output-filter-functions #\\='comint-truncate-buffer)))) Here is another example. It will always put point back to the statement you entered, right above the output it created. \(setq comint-output-filter-functions (function (lambda (STR) (comint-show-output))))" + ;; FIXME: The doc above uses `setq' on `comint-output-filter-functions', + ;; whereas hooks should be manipulated with things like `add/remove-hook'. (delay-mode-hooks (comint-mode)) ;; Get the `sql-product' for this interactive session. @@ -4193,7 +4336,8 @@ you entered, right above the output it created. (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. - (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) + (let ((proc (get-buffer-process (current-buffer)))) + (when proc (set-process-sentinel proc #'sql-stop))) ;; Save the connection and login params (set (make-local-variable 'sql-user) sql-user) (set (make-local-variable 'sql-database) sql-database) @@ -4211,7 +4355,7 @@ you entered, right above the output it created. (sql-make-alternate-buffer-name)) ;; User stuff. Initialize before the hook. (set (make-local-variable 'sql-prompt-regexp) - (sql-get-product-feature sql-product :prompt-regexp)) + (or (sql-get-product-feature sql-product :prompt-regexp) "^")) (set (make-local-variable 'sql-prompt-length) (sql-get-product-feature sql-product :prompt-length)) (set (make-local-variable 'sql-prompt-cont-regexp) @@ -4219,7 +4363,7 @@ you entered, right above the output it created. (make-local-variable 'sql-output-newline-count) (make-local-variable 'sql-preoutput-hold) (add-hook 'comint-preoutput-filter-functions - 'sql-interactive-remove-continuation-prompt nil t) + #'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) (make-local-variable 'sql-input-ring-file-name) ;; Run the mode hook (along with comint's hooks). @@ -4230,7 +4374,7 @@ you entered, right above the output it created. (concat "\\(" sql-prompt-regexp "\\|" sql-prompt-cont-regexp "\\)") sql-prompt-regexp)) - (setq left-margin sql-prompt-length) + (setq left-margin (or sql-prompt-length 0)) ;; Install input sender (set (make-local-variable 'comint-input-sender) 'sql-input-sender) ;; People wanting a different history file for each @@ -4268,8 +4412,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." "Read a connection name." (let ((completion-ignore-case t)) (completing-read prompt - (mapcar (lambda (c) (car c)) - sql-connection-alist) + (mapcar #'car sql-connection-alist) nil t initial 'sql-connection-history default))) ;;;###autoload @@ -4480,6 +4623,10 @@ the call to \\[sql-product-interactive] with (or sql-default-directory default-directory))) + ;; The password wallet returns a function which supplies the password. + (when (functionp sql-password) + (setq sql-password (funcall sql-password))) + ;; Call the COMINT service (funcall (sql-get-product-feature product :sqli-comint-func) product @@ -4522,7 +4669,8 @@ the call to \\[sql-product-interactive] with (let ((proc (get-buffer-process new-sqli-buffer)) (secs sql-login-delay) (step 0.3)) - (while (and (memq (process-status proc) '(open run)) + (while (and proc + (memq (process-status proc) '(open run)) (or (accept-process-output proc step) (<= 0.0 (setq secs (- secs step)))) (progn (goto-char (point-max)) @@ -5226,8 +5374,7 @@ The default comes from `process-coding-system-alist' and your might try undecided-dos as a coding system. If this doesn't help, Try to set `comint-output-filter-functions' like this: -\(setq comint-output-filter-functions (append comint-output-filter-functions - \\='(comint-strip-ctrl-m))) +\(add-hook 'comint-output-filter-functions #\\='comint-strip-ctrl-m 'append) \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" (interactive "P") |