diff options
Diffstat (limited to 'lisp/progmodes')
56 files changed, 3254 insertions, 2439 deletions
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 4bc6de0c759..d6e2ab8a87a 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -2437,7 +2437,6 @@ the default language." #'antlr-imenu-create-index-function) (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test (and antlr-imenu-name ; there should be a global variable... - (fboundp 'imenu-add-to-menubar) (imenu-add-to-menubar (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) (antlr-set-tabs)) diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 370fb1b80b4..aaf063b5174 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -24,16 +24,16 @@ ;;; Commentary: ;; This mode was written by Eric S. Raymond <esr@snark.thyrsus.com>, -;; inspired by an earlier asm-mode by Martin Neitzel. +;; inspired by an earlier `asm-mode' by Martin Neitzel. -;; This major mode is based on prog mode. It defines a private abbrev table -;; that can be used to save abbrevs for assembler mnemonics. It binds just -;; five keys: +;; This major mode is based on `prog-mode'. It defines a private +;; abbrev table that can be used to save abbrevs for assembler +;; mnemonics. It binds just five keys: ;; ;; TAB tab to next tab stop ;; : outdent preceding label, tab to tab stop ;; comment char place or move comment -;; asm-comment-char specifies which character this is; +;; `asm-comment-char' specifies which character this is; ;; you can use a different character in different ;; Asm mode buffers. ;; C-j, C-m newline and tab to tab stop @@ -41,9 +41,9 @@ ;; Code is indented to the first tab stop level. ;; This mode runs two hooks: -;; 1) An asm-mode-set-comment-hook before the part of the initialization -;; depending on asm-comment-char, and -;; 2) an asm-mode-hook at the end of initialization. +;; 1) `asm-mode-set-comment-hook' before the part of the initialization +;; depending on `asm-comment-char', and +;; 2) `asm-mode-hook' at the end of initialization. ;;; Code: @@ -68,13 +68,11 @@ "Abbrev table used while in Asm mode.") (define-abbrev-table 'asm-mode-abbrev-table ()) -(defvar asm-mode-map - (let ((map (make-sparse-keymap))) - ;; Note that the comment character isn't set up until asm-mode is called. - (define-key map ":" 'asm-colon) - (define-key map "\C-c;" 'comment-region) - map) - "Keymap for Asm mode.") +(defvar-keymap asm-mode-map + :doc "Keymap for Asm mode." + ;; Note that the comment character isn't set up until asm-mode is called. + ":" #'asm-colon + "C-c ;" #'comment-region) (easy-menu-define asm-mode-menu asm-mode-map "Menu for Asm mode." @@ -130,7 +128,7 @@ Special commands: (setq-local tab-always-indent nil) (run-hooks 'asm-mode-set-comment-hook) - ;; Make our own local child of asm-mode-map + ;; Make our own local child of `asm-mode-map' ;; so we can define our own comment character. (use-local-map (nconc (make-sparse-keymap) asm-mode-map)) (local-set-key (vector asm-comment-char) #'asm-comment) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 7ef2500e46b..6bac297a298 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -71,8 +71,8 @@ "doskey" "echo" "endlocal" "erase" "fc" "find" "findstr" "format" "ftype" "label" "md" "mkdir" "more" "move" "net" "path" "pause" "popd" "prompt" "pushd" "rd" "ren" "rename" "replace" "rmdir" "set" - "setlocal" "shift" "sort" "subst" "time" "title" "tree" "type" - "ver" "vol" "xcopy")) + "setlocal" "setx" "shift" "sort" "subst" "time" "title" "tree" + "type" "ver" "vol" "xcopy")) (CONTROLFLOW '("call" "cmd" "defined" "do" "else" "equ" "exist" "exit" "for" "geq" "goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start")) @@ -82,7 +82,7 @@ (2 font-lock-constant-face t)) ("^:[^:].*" . 'bat-label-face) - ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" + ("\\_<\\(defined\\|set\\|setx\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) ("%~\\([0-9]\\)" (1 font-lock-variable-name-face)) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 06242a4cba8..d3626dbaf01 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -40,12 +40,10 @@ ;; Somewhat arbitrary, by analogy with eg goto-address. :group 'comm) -(defvar bug-reference-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'bug-reference-push-button) - (define-key map (kbd "C-c RET") 'bug-reference-push-button) - map) - "Keymap used by bug reference buttons.") +(defvar-keymap bug-reference-map + :doc "Keymap used by bug reference buttons." + "<mouse-2>" #'bug-reference-push-button + "C-c RET" #'bug-reference-push-button) ;; E.g., "https://gcc.gnu.org/PR%s" (defvar bug-reference-url-format nil diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 8298d5fef04..e14f5b9058f 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -202,6 +202,58 @@ Works with: arglist-cont-nonempty, arglist-close." (skip-chars-forward " \t")) (vector (current-column))))))) +(defun c-lineup-argcont-1 (elem) + ;; Move to the start of the current arg and return non-nil, otherwise + ;; return nil. + (beginning-of-line) + + (when (eq (car elem) 'arglist-cont-nonempty) + ;; Our argument list might not be the innermost one. If it + ;; isn't, go back to the first position in it. We do this by + ;; stepping back over open parens until we get to the open paren + ;; of our argument list. + (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) + (paren-state (c-parse-state))) + (while (not (eq (car paren-state) open-paren)) + (unless (consp (car paren-state)) ;; ignore matched braces + (goto-char (car paren-state))) + (setq paren-state (cdr paren-state))))) + + (let ((start (point)) c) + + (when (bolp) + ;; Previous line ending in a comma means we're the start of an + ;; argument. This should quickly catch most cases not for us. + ;; This case is only applicable if we're the innermost arglist. + (c-backward-syntactic-ws) + (setq c (char-before))) + + (unless (eq c ?,) + ;; In a gcc asm, ":" on the previous line means the start of an + ;; argument. And lines starting with ":" are not for us, don't + ;; want them to indent to the preceding operand. + (let ((gcc-asm (save-excursion + (goto-char start) + (c-in-gcc-asm-p)))) + (unless (and gcc-asm + (or (eq c ?:) + (save-excursion + (goto-char start) + (looking-at "[ \t]*:")))) + + (c-lineup-argcont-scan (if gcc-asm ?:)) + t))))) + +(defun c-lineup-argcont-scan (&optional other-match) + ;; Find the start of an argument, for `c-lineup-argcont'. + (when (zerop (c-backward-token-2 1 t)) + (let ((c (char-after))) + (if (or (eq c ?,) (eq c other-match)) + (progn + (forward-char) + (c-forward-syntactic-ws)) + (c-lineup-argcont-scan other-match))))) + ;; Contributed by Kevin Ryde <user42@zip.com.au>. (defun c-lineup-argcont (elem) "Line up a continued argument. @@ -217,56 +269,30 @@ but of course only between operand specifications, not in the expressions for the operands. Works with: arglist-cont, arglist-cont-nonempty." - (save-excursion - (beginning-of-line) + (when (c-lineup-argcont-1 elem) + (vector (current-column))))) - (when (eq (car elem) 'arglist-cont-nonempty) - ;; Our argument list might not be the innermost one. If it - ;; isn't, go back to the last position in it. We do this by - ;; stepping back over open parens until we get to the open paren - ;; of our argument list. - (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) - (paren-state (c-parse-state))) - (while (not (eq (car paren-state) open-paren)) - (unless (consp (car paren-state)) ;; ignore matched braces - (goto-char (car paren-state))) - (setq paren-state (cdr paren-state))))) - - (let ((start (point)) c) - - (when (bolp) - ;; Previous line ending in a comma means we're the start of an - ;; argument. This should quickly catch most cases not for us. - ;; This case is only applicable if we're the innermost arglist. - (c-backward-syntactic-ws) - (setq c (char-before))) - - (unless (eq c ?,) - ;; In a gcc asm, ":" on the previous line means the start of an - ;; argument. And lines starting with ":" are not for us, don't - ;; want them to indent to the preceding operand. - (let ((gcc-asm (save-excursion - (goto-char start) - (c-in-gcc-asm-p)))) - (unless (and gcc-asm - (or (eq c ?:) - (save-excursion - (goto-char start) - (looking-at "[ \t]*:")))) - - (c-lineup-argcont-scan (if gcc-asm ?:)) - (vector (current-column)))))))) +(defun c-lineup-argcont-+ (langelem) + "Indent an argument continuation `c-basic-offset' in from the first argument. -(defun c-lineup-argcont-scan (&optional other-match) - ;; Find the start of an argument, for `c-lineup-argcont'. - (when (zerop (c-backward-token-2 1 t)) - (let ((c (char-after))) - (if (or (eq c ?,) (eq c other-match)) - (progn - (forward-char) - (c-forward-syntactic-ws)) - (c-lineup-argcont-scan other-match))))) +This first argument is that on a previous line at the same level of nesting. + +foo (xyz, uvw, aaa + bbb + ccc + + ddd + eee + fff); <- c-lineup-argcont-+ + <--> c-basic-offset + +Only continuation lines like this are touched, nil being returned +on lines which are the start of an argument. + +Works with: arglist-cont, arglist-cont-nonempty." + (save-excursion + (when (c-lineup-argcont-1 langelem) ; Check we've got a continued argument... + ;; ... but ignore the position found. + (goto-char (c-langelem-2nd-pos c-syntactic-element)) + (forward-char) + (c-forward-syntactic-ws) + (vector (+ (current-column) c-basic-offset))))) (defun c-lineup-arglist-intro-after-paren (_langelem) "Line up a line to just after the open paren of the surrounding paren diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 188d5a8a837..9ea1557391b 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -56,6 +56,8 @@ ;; Silence the byte compiler. (cc-bytecomp-defvar c-new-BEG) (cc-bytecomp-defvar c-new-END) +(cc-bytecomp-defun c-restore-string-fences) +(cc-bytecomp-defun c-clear-string-fences) ;; Some functions in cc-engine that are used below. There's a cyclic ;; dependency so it can't be required here. (Perhaps some functions @@ -934,7 +936,7 @@ ;; It prepares the buffer for font ;; locking, hence must get called before `font-lock-after-change-function'. ;; - ;; This function is the AWK value of `c-before-font-lock-function'. + ;; This function is the AWK value of `c-before-font-lock-functions'. ;; It does hidden buffer changes. (c-save-buffer-state () (setq c-new-END (c-awk-end-of-change-region beg end old-len)) @@ -1109,29 +1111,30 @@ nor helpful. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (interactive "p") - (or arg (setq arg 1)) - (save-match-data - (c-save-buffer-state ; ensures the buffer is writable. - nil - (let ((found t)) ; Has the most recent regexp search found b-of-defun? - (if (>= arg 0) - ;; Go back one defun each time round the following loop. (For +ve arg) - (while (and found (> arg 0) (not (eq (point) (point-min)))) - ;; Go back one "candidate" each time round the next loop until one - ;; is genuinely a beginning-of-defun. - (while (and (setq found (search-backward-regexp - "^[^#} \t\n\r]" (point-min) 'stop-at-limit)) - (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#))))) - (setq arg (1- arg))) - ;; The same for a -ve arg. - (if (not (eq (point) (point-max))) (forward-char 1)) - (while (and found (< arg 0) (not (eq (point) (point-max)))) ; The same for -ve arg. - (while (and (setq found (search-forward-regexp - "^[^#} \t\n\r]" (point-max) 'stop-at-limit)) - (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#))))) - (setq arg (1+ arg))) - (if found (goto-char (match-beginning 0)))) - (eq arg 0))))) + (c-with-string-fences + (or arg (setq arg 1)) + (save-match-data + (c-save-buffer-state ; ensures the buffer is writable. + nil + (let ((found t)) ; Has the most recent regexp search found b-of-defun? + (if (>= arg 0) + ;; Go back one defun each time round the following loop. (For +ve arg) + (while (and found (> arg 0) (not (eq (point) (point-min)))) + ;; Go back one "candidate" each time round the next loop until one + ;; is genuinely a beginning-of-defun. + (while (and (setq found (search-backward-regexp + "^[^#} \t\n\r]" (point-min) 'stop-at-limit)) + (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#))))) + (setq arg (1- arg))) + ;; The same for a -ve arg. + (if (not (eq (point) (point-max))) (forward-char 1)) + (while (and found (< arg 0) (not (eq (point) (point-max)))) ; The same for -ve arg. + (while (and (setq found (search-forward-regexp + "^[^#} \t\n\r]" (point-max) 'stop-at-limit)) + (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#))))) + (setq arg (1+ arg))) + (if found (goto-char (match-beginning 0)))) + (eq arg 0)))))) (defun c-awk-forward-awk-pattern () ;; Point is at the start of an AWK pattern (which may be null) or function @@ -1187,39 +1190,40 @@ no explicit action; see function `c-awk-beginning-of-defun'. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (interactive "p") - (or arg (setq arg 1)) - (save-match-data - (c-save-buffer-state - nil - (let ((start-point (point)) end-point) - ;; Strategy: (For +ve ARG): If we're not already at a beginning-of-defun, - ;; move backwards to one. - ;; Repeat [(i) move forward to end-of-current-defun (see below); - ;; (ii) If this isn't it, move forward to beginning-of-defun]. - ;; We start counting ARG only when step (i) has passed the original point. - (when (> arg 0) - ;; Try to move back to a beginning-of-defun, if not already at one. - (if (not (c-awk-beginning-of-defun-p)) - (when (not (c-awk-beginning-of-defun 1)) ; No bo-defun before point. - (goto-char start-point) - (c-awk-beginning-of-defun -1))) ; if this fails, we're at EOB, tough! - ;; Now count forward, one defun at a time - (while (and (not (eobp)) - (c-awk-end-of-defun1) - (if (> (point) start-point) (setq arg (1- arg)) t) - (> arg 0) - (c-awk-beginning-of-defun -1)))) - - (when (< arg 0) - (setq end-point start-point) - (while (and (not (bobp)) - (c-awk-beginning-of-defun 1) - (if (< (setq end-point (if (bobp) (point) - (save-excursion (c-awk-end-of-defun1)))) - start-point) - (setq arg (1+ arg)) t) - (< arg 0))) - (goto-char (min start-point end-point))))))) + (c-with-string-fences + (or arg (setq arg 1)) + (save-match-data + (c-save-buffer-state + nil + (let ((start-point (point)) end-point) + ;; Strategy: (For +ve ARG): If we're not already at a beginning-of-defun, + ;; move backwards to one. + ;; Repeat [(i) move forward to end-of-current-defun (see below); + ;; (ii) If this isn't it, move forward to beginning-of-defun]. + ;; We start counting ARG only when step (i) has passed the original point. + (when (> arg 0) + ;; Try to move back to a beginning-of-defun, if not already at one. + (if (not (c-awk-beginning-of-defun-p)) + (when (not (c-awk-beginning-of-defun 1)) ; No bo-defun before point. + (goto-char start-point) + (c-awk-beginning-of-defun -1))) ; if this fails, we're at EOB, tough! + ;; Now count forward, one defun at a time + (while (and (not (eobp)) + (c-awk-end-of-defun1) + (if (> (point) start-point) (setq arg (1- arg)) t) + (> arg 0) + (c-awk-beginning-of-defun -1)))) + + (when (< arg 0) + (setq end-point start-point) + (while (and (not (bobp)) + (c-awk-beginning-of-defun 1) + (if (< (setq end-point (if (bobp) (point) + (save-excursion (c-awk-end-of-defun1)))) + start-point) + (setq arg (1+ arg)) t) + (< arg 0))) + (goto-char (min start-point end-point)))))))) (cc-provide 'cc-awk) ; Changed from 'awk-mode, ACM 2002/5/21 diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index e9237bb01e2..82268f49433 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -49,6 +49,8 @@ ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) (cc-bytecomp-defvar c-indent-to-body-directives) +(cc-bytecomp-defun c-restore-string-fences) +(cc-bytecomp-defun c-clear-string-fences) (defvar c-syntactic-context) ;; Indentation / Display syntax functions @@ -210,35 +212,36 @@ and takes care to set the indentation before calling "Show syntactic information for current line. With universal argument, inserts the analysis as a comment on that line." (interactive "P") - (let* ((c-parsing-error nil) - (syntax (if (boundp 'c-syntactic-context) - ;; Use `c-syntactic-context' in the same way as - ;; `c-indent-line', to be consistent. - c-syntactic-context - (c-save-buffer-state nil - (c-guess-basic-syntax))))) - (if (not (consp arg)) - (let (elem pos ols) - (message "Syntactic analysis: %s" syntax) - (unwind-protect - (progn - (while syntax - (setq elem (pop syntax)) - (when (setq pos (c-langelem-pos elem)) - (push (c-put-overlay pos (1+ pos) - 'face 'highlight) - ols)) - (when (setq pos (c-langelem-2nd-pos elem)) - (push (c-put-overlay pos (1+ pos) - 'face 'secondary-selection) - ols))) - (sit-for 10)) - (while ols - (c-delete-overlay (pop ols))))) - (indent-for-comment) - (insert-and-inherit (format "%s" syntax)) - )) - (c-keep-region-active)) + (c-with-string-fences + (let* ((c-parsing-error nil) + (syntax (if (boundp 'c-syntactic-context) + ;; Use `c-syntactic-context' in the same way as + ;; `c-indent-line', to be consistent. + c-syntactic-context + (c-save-buffer-state nil + (c-guess-basic-syntax))))) + (if (not (consp arg)) + (let (elem pos ols) + (message "Syntactic analysis: %s" syntax) + (unwind-protect + (progn + (while syntax + (setq elem (pop syntax)) + (when (setq pos (c-langelem-pos elem)) + (push (c-put-overlay pos (1+ pos) + 'face 'highlight) + ols)) + (when (setq pos (c-langelem-2nd-pos elem)) + (push (c-put-overlay pos (1+ pos) + 'face 'secondary-selection) + ols))) + (sit-for 10)) + (while ols + (c-delete-overlay (pop ols))))) + (indent-for-comment) + (insert-and-inherit (format "%s" syntax)) + )) + (c-keep-region-active))) (defun c-syntactic-information-on-region (from to) "Insert a comment with the syntactic analysis on every line in the region." @@ -414,23 +417,25 @@ argument is supplied, or `c-hungry-delete-key' is nil, or point is inside a literal then the function in the variable `c-backspace-function' is called." (interactive "*P") - (if (c-save-buffer-state () - (or (not c-hungry-delete-key) - arg - (c-in-literal))) - (funcall c-backspace-function (prefix-numeric-value arg)) - (c-hungry-delete-backwards))) + (c-with-string-fences + (if (c-save-buffer-state () + (or (not c-hungry-delete-key) + arg + (c-in-literal))) + (funcall c-backspace-function (prefix-numeric-value arg)) + (c-hungry-delete-backwards)))) (defun c-hungry-delete-backwards () "Delete the preceding character or all preceding whitespace back to the previous non-whitespace character. See also \\[c-hungry-delete-forward]." (interactive) - (let ((here (point))) - (c-skip-ws-backward) - (if (/= (point) here) - (delete-region (point) here) - (funcall c-backspace-function 1)))) + (c-with-string-fences + (let ((here (point))) + (c-skip-ws-backward) + (if (/= (point) here) + (delete-region (point) here) + (funcall c-backspace-function 1))))) (defalias 'c-hungry-backspace 'c-hungry-delete-backwards) @@ -442,23 +447,26 @@ argument is supplied, or `c-hungry-delete-key' is nil, or point is inside a literal then the function in the variable `c-delete-function' is called." (interactive "*P") - (if (c-save-buffer-state () - (or (not c-hungry-delete-key) - arg - (c-in-literal))) - (funcall c-delete-function (prefix-numeric-value arg)) - (c-hungry-delete-forward))) + (c-with-string-fences + (if + (c-save-buffer-state () + (or (not c-hungry-delete-key) + arg + (c-in-literal))) + (funcall c-delete-function (prefix-numeric-value arg)) + (c-hungry-delete-forward)))) (defun c-hungry-delete-forward () "Delete the following character or all following whitespace up to the next non-whitespace character. See also \\[c-hungry-delete-backwards]." (interactive) - (let ((here (point))) - (c-skip-ws-forward) - (if (/= (point) here) - (delete-region (point) here) - (funcall c-delete-function 1)))) + (c-with-string-fences + (let ((here (point))) + (c-skip-ws-forward) + (if (/= (point) here) + (delete-region (point) here) + (funcall c-delete-function 1))))) ;; This function is only used in XEmacs. (defun c-electric-delete (arg) @@ -519,7 +527,8 @@ function to control that." (defmacro c--call-post-self-insert-hook-more-safely () ;; Call post-self-insert-hook, if such exists. See comment for - ;; `c--call-post-self-insert-hook-more-safely-1'. + ;; `c--call-post-self-insert-hook-more-safely-1'. This macro should be + ;; invoked OUTSIDE of `c-with-string-fences'. (if (boundp 'post-self-insert-hook) '(c--call-post-self-insert-hook-more-safely-1) '(progn))) @@ -530,30 +539,30 @@ If `c-electric-flag' is set, handle it specially according to the variable `c-electric-pound-behavior'. If a numeric ARG is supplied, or if point is inside a literal or a macro, nothing special happens." (interactive "*P") - (if (c-save-buffer-state () - (or arg - (not c-electric-flag) - (not (memq 'alignleft c-electric-pound-behavior)) - (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (save-excursion - (and (= (forward-line -1) 0) - (progn (end-of-line) - (eq (char-before) ?\\)))) - (c-in-literal))) - ;; do nothing special - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - ;; place the pound character at the left edge - (let ((pos (- (point-max) (point))) - (bolp (bolp))) - (beginning-of-line) - (delete-horizontal-space) - (insert (c-last-command-char)) - (and (not bolp) - (goto-char (- (point-max) pos))) - )) + (c-with-string-fences + (if (c-save-buffer-state () + (or arg + (not c-electric-flag) + (not (memq 'alignleft c-electric-pound-behavior)) + (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (save-excursion + (and (= (forward-line -1) 0) + (progn (end-of-line) + (eq (char-before) ?\\)))) + (c-in-literal))) + ;; do nothing special + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + ;; place the pound character at the left edge + (let ((pos (- (point-max) (point))) + (bolp (bolp))) + (beginning-of-line) + (delete-horizontal-space) + (insert (c-last-command-char)) + (and (not bolp) + (goto-char (- (point-max) pos)))))) (c--call-post-self-insert-hook-more-safely)) (defun c-point-syntax () @@ -883,25 +892,26 @@ settings of `c-cleanup-list' are done." (interactive "*P") (let (safepos literal - ;; We want to inhibit blinking the paren since this would be - ;; most disruptive. We'll blink it ourselves later on. - (old-blink-paren blink-paren-function) - blink-paren-function case-fold-search - (at-eol (looking-at "[ \t]*\\\\?$")) - (active-region (and (fboundp 'use-region-p) (use-region-p))) - got-pair-} electric-pair-deletion) - - (c-save-buffer-state () - (setq safepos (c-safe-position (point) (c-parse-state)) - literal (c-in-literal safepos))) - - ;; Insert the brace. Note that expand-abbrev might reindent - ;; the line here if there's a preceding "else" or something. - (let (post-self-insert-hook) ; the only way to get defined functionality - ; from `self-insert-command'. - (self-insert-command (prefix-numeric-value arg))) - - ;; Emulate `electric-pair-mode'. + ;; We want to inhibit blinking the paren since this would be + ;; most disruptive. We'll blink it ourselves later on. + (old-blink-paren blink-paren-function) + blink-paren-function case-fold-search + (at-eol (looking-at "[ \t]*\\\\?$")) + (active-region (and (fboundp 'use-region-p) (use-region-p))) + got-pair-} electric-pair-deletion) + + (c-with-string-fences + (c-save-buffer-state () + (setq safepos (c-safe-position (point) (c-parse-state)) + literal (c-in-literal safepos))) + + ;; Insert the brace. Note that expand-abbrev might reindent + ;; the line here if there's a preceding "else" or something. + (let (post-self-insert-hook) ; the only way to get defined functionality + ; from `self-insert-command'. + (self-insert-command (prefix-numeric-value arg)))) + + ;; Emulate `electric-pair-mode', outside of `c-with-string-fences'. (when (and (boundp 'electric-pair-mode) electric-pair-mode) (let ((size (buffer-size)) @@ -912,30 +922,31 @@ settings of `c-cleanup-list' are done." (eq (char-after) ?})) electric-pair-deletion (< (buffer-size) size)))) - ;; Perform any required CC Mode electric actions. - (cond - ((or literal arg (not c-electric-flag) active-region)) - ((not at-eol) - (c-indent-line)) - (electric-pair-deletion - (c-indent-line) - (c-do-brace-electrics 'ignore nil)) - (t (c-do-brace-electrics nil nil) - (when got-pair-} + (c-with-string-fences + ;; Perform any required CC Mode electric actions. + (cond + ((or literal arg (not c-electric-flag) active-region)) + ((not at-eol) + (c-indent-line)) + (electric-pair-deletion + (c-indent-line) + (c-do-brace-electrics 'ignore nil)) + (t (c-do-brace-electrics nil nil) + (when got-pair-} + (save-excursion + (forward-char) + (c-do-brace-electrics 'assume 'ignore)) + (c-indent-line)))) + + ;; blink the paren + (and (eq (c-last-command-char) ?\}) + (not executing-kbd-macro) + old-blink-paren (save-excursion - (forward-char) - (c-do-brace-electrics 'assume 'ignore)) - (c-indent-line)))) - - ;; blink the paren - (and (eq (c-last-command-char) ?\}) - (not executing-kbd-macro) - old-blink-paren - (save-excursion - (c-save-buffer-state nil - (c-backward-syntactic-ws safepos)) - (funcall old-blink-paren))) - (c--call-post-self-insert-hook-more-safely))) + (c-save-buffer-state nil + (c-backward-syntactic-ws safepos)) + (funcall old-blink-paren))))) + (c--call-post-self-insert-hook-more-safely)) (defun c-electric-slash (arg) "Insert a slash character. @@ -956,39 +967,40 @@ If a numeric ARG is supplied, point is inside a literal, or `c-syntactic-indentation' is nil or `c-electric-flag' is nil, indentation is inhibited." (interactive "*P") - (let ((literal (c-save-buffer-state () (c-in-literal))) - indentp - ;; shut this up - (c-echo-syntactic-information-p nil)) + (c-with-string-fences + (let ((literal (c-save-buffer-state () (c-in-literal))) + indentp + ;; shut this up + (c-echo-syntactic-information-p nil)) - ;; comment-close-slash cleanup? This DOESN'T need `c-electric-flag' or - ;; `c-syntactic-indentation' set. - (when (and (not arg) - (eq literal 'c) - (memq 'comment-close-slash c-cleanup-list) - (eq (c-last-command-char) ?/) - (looking-at (concat "[ \t]*\\(" - (regexp-quote comment-end) "\\)?$")) - ; (eq c-block-comment-ender "*/") ; C-style comments ALWAYS end in */ - (save-excursion - (save-restriction - (narrow-to-region (point-min) (point)) - (back-to-indentation) - (looking-at (concat c-current-comment-prefix "[ \t]*$"))))) - (delete-region (progn (forward-line 0) (point)) - (progn (end-of-line) (point))) - (insert-char ?* 1)) ; the / comes later. ; Do I need a t (retain sticky properties) here? - - (setq indentp (and (not arg) - c-syntactic-indentation - c-electric-flag - (eq (c-last-command-char) ?/) - (eq (char-before) (if literal ?* ?/)))) - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - (if indentp - (indent-according-to-mode)) - (c--call-post-self-insert-hook-more-safely))) + ;; comment-close-slash cleanup? This DOESN'T need `c-electric-flag' or + ;; `c-syntactic-indentation' set. + (when (and (not arg) + (eq literal 'c) + (memq 'comment-close-slash c-cleanup-list) + (eq (c-last-command-char) ?/) + (looking-at (concat "[ \t]*\\(" + (regexp-quote comment-end) "\\)?$")) + ; (eq c-block-comment-ender "*/") ; C-style comments ALWAYS end in */ + (save-excursion + (save-restriction + (narrow-to-region (point-min) (point)) + (back-to-indentation) + (looking-at (concat c-current-comment-prefix "[ \t]*$"))))) + (delete-region (progn (forward-line 0) (point)) + (progn (end-of-line) (point))) + (insert-char ?* 1)) ; the / comes later. ; Do I need a t (retain sticky properties) here? + + (setq indentp (and (not arg) + c-syntactic-indentation + c-electric-flag + (eq (c-last-command-char) ?/) + (eq (char-before) (if literal ?* ?/)))) + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + (if indentp + (indent-according-to-mode)))) + (c--call-post-self-insert-hook-more-safely)) (defun c-electric-star (arg) "Insert a star character. @@ -999,26 +1011,26 @@ supplied, point is inside a literal, or `c-syntactic-indentation' is nil, this indentation is inhibited." (interactive "*P") - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - ;; if we are in a literal, or if arg is given do not reindent the - ;; current line, unless this star introduces a comment-only line. - (if (c-save-buffer-state () - (and c-syntactic-indentation - c-electric-flag - (not arg) - (eq (c-in-literal) 'c) - (eq (char-before) ?*) - (save-excursion - (forward-char -1) - (skip-chars-backward "*") - (if (eq (char-before) ?/) - (forward-char -1)) - (skip-chars-backward " \t") - (bolp)))) - (let (c-echo-syntactic-information-p) ; shut this up - (indent-according-to-mode)) - ) + (c-with-string-fences + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + ;; if we are in a literal, or if arg is given do not reindent the + ;; current line, unless this star introduces a comment-only line. + (if (c-save-buffer-state () + (and c-syntactic-indentation + c-electric-flag + (not arg) + (eq (c-in-literal) 'c) + (eq (char-before) ?*) + (save-excursion + (forward-char -1) + (skip-chars-backward "*") + (if (eq (char-before) ?/) + (forward-char -1)) + (skip-chars-backward " \t") + (bolp)))) + (let (c-echo-syntactic-information-p) ; shut this up + (indent-according-to-mode)))) (c--call-post-self-insert-hook-more-safely)) (defun c-electric-semi&comma (arg) @@ -1039,60 +1051,61 @@ reindented unless `c-syntactic-indentation' is nil. semicolon following a defun might be cleaned up, depending on the settings of `c-cleanup-list'." (interactive "*P") - (let* (lim literal c-syntactic-context - (here (point)) - ;; shut this up - (c-echo-syntactic-information-p nil)) - - (c-save-buffer-state () - (setq lim (c-most-enclosing-brace (c-parse-state)) - literal (c-in-literal lim))) - - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - - (if (and c-electric-flag (not literal) (not arg)) - ;; do all cleanups and newline insertions if c-auto-newline is on. - (if (or (not c-auto-newline) - (not (looking-at "[ \t]*\\\\?$"))) - (if c-syntactic-indentation - (c-indent-line)) - ;; clean ups: list-close-comma or defun-close-semi - (let ((pos (- (point-max) (point)))) - (if (c-save-buffer-state () - (and (or (and - (eq (c-last-command-char) ?,) - (memq 'list-close-comma c-cleanup-list)) - (and - (eq (c-last-command-char) ?\;) - (memq 'defun-close-semi c-cleanup-list))) - (progn - (forward-char -1) - (c-skip-ws-backward) - (eq (char-before) ?})) - ;; make sure matching open brace isn't in a comment - (not (c-in-literal lim)))) - (delete-region (point) here)) - (goto-char (- (point-max) pos))) - ;; reindent line - (when c-syntactic-indentation - (setq c-syntactic-context (c-guess-basic-syntax)) - (c-indent-line c-syntactic-context)) - ;; check to see if a newline should be added - (let ((criteria c-hanging-semi&comma-criteria) - answer add-newline-p) - (while criteria - (setq answer (funcall (car criteria))) - ;; only nil value means continue checking - (if (not answer) - (setq criteria (cdr criteria)) - (setq criteria nil) - ;; only 'stop specifically says do not add a newline - (setq add-newline-p (not (eq answer 'stop))) - )) - (if add-newline-p - (c-newline-and-indent))))) - (c--call-post-self-insert-hook-more-safely))) + (c-with-string-fences + (let* (lim literal c-syntactic-context + (here (point)) + ;; shut this up + (c-echo-syntactic-information-p nil)) + + (c-save-buffer-state () + (setq lim (c-most-enclosing-brace (c-parse-state)) + literal (c-in-literal lim))) + + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + + (if (and c-electric-flag (not literal) (not arg)) + ;; do all cleanups and newline insertions if c-auto-newline is on. + (if (or (not c-auto-newline) + (not (looking-at "[ \t]*\\\\?$"))) + (if c-syntactic-indentation + (c-indent-line)) + ;; clean ups: list-close-comma or defun-close-semi + (let ((pos (- (point-max) (point)))) + (if (c-save-buffer-state () + (and (or (and + (eq (c-last-command-char) ?,) + (memq 'list-close-comma c-cleanup-list)) + (and + (eq (c-last-command-char) ?\;) + (memq 'defun-close-semi c-cleanup-list))) + (progn + (forward-char -1) + (c-skip-ws-backward) + (eq (char-before) ?})) + ;; make sure matching open brace isn't in a comment + (not (c-in-literal lim)))) + (delete-region (point) here)) + (goto-char (- (point-max) pos))) + ;; reindent line + (when c-syntactic-indentation + (setq c-syntactic-context (c-guess-basic-syntax)) + (c-indent-line c-syntactic-context)) + ;; check to see if a newline should be added + (let ((criteria c-hanging-semi&comma-criteria) + answer add-newline-p) + (while criteria + (setq answer (funcall (car criteria))) + ;; only nil value means continue checking + (if (not answer) + (setq criteria (cdr criteria)) + (setq criteria nil) + ;; only 'stop specifically says do not add a newline + (setq add-newline-p (not (eq answer 'stop))) + )) + (if add-newline-p + (c-newline-and-indent))))))) + (c--call-post-self-insert-hook-more-safely)) (defun c-electric-colon (arg) "Insert a colon. @@ -1113,89 +1126,90 @@ reindented unless `c-syntactic-indentation' is nil. `c-cleanup-list'." (interactive "*P") - (let* ((bod (c-point 'bod)) - (literal (c-save-buffer-state () (c-in-literal bod))) - newlines is-scope-op - ;; shut this up - (c-echo-syntactic-information-p nil)) - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - ;; Any electric action? - (if (and c-electric-flag (not literal) (not arg)) - ;; Unless we're at EOL, only re-indentation happens. - (if (not (looking-at "[ \t]*\\\\?$")) - (if c-syntactic-indentation - (indent-according-to-mode)) - - ;; scope-operator clean-up? - (let ((pos (- (point-max) (point))) - (here (point))) - (if (c-save-buffer-state () ; Why do we need this? [ACM, 2003-03-12] - (and c-auto-newline - (memq 'scope-operator c-cleanup-list) - (eq (char-before) ?:) - (progn - (forward-char -1) - (c-skip-ws-backward) - (eq (char-before) ?:)) - (not (c-in-literal)) - (not (eq (char-after (- (point) 2)) ?:)))) - (progn - (delete-region (point) (1- here)) - (setq is-scope-op t))) - (goto-char (- (point-max) pos))) - - ;; indent the current line if it's done syntactically. - (if c-syntactic-indentation - ;; Cannot use the same syntax analysis as we find below, - ;; since that's made with c-syntactic-indentation-in-macros - ;; always set to t. - (indent-according-to-mode)) - - ;; Calculate where, if anywhere, we want newlines. - (c-save-buffer-state - ((c-syntactic-indentation-in-macros t) - (c-auto-newline-analysis t) - ;; Turn on syntactic macro analysis to help with auto newlines - ;; only. - (syntax (c-guess-basic-syntax)) - (elem syntax)) - ;; Translate substatement-label to label for this operation. - (while elem - (if (eq (car (car elem)) 'substatement-label) - (setcar (car elem) 'label)) - (setq elem (cdr elem))) - ;; some language elements can only be determined by checking - ;; the following line. Let's first look for ones that can be - ;; found when looking on the line with the colon - (setq newlines - (and c-auto-newline - (or (c-lookup-lists '(case-label label access-label) - syntax c-hanging-colons-alist) - (c-lookup-lists '(member-init-intro inher-intro) - (progn - (insert ?\n) - (unwind-protect - (c-guess-basic-syntax) - (delete-char -1))) - c-hanging-colons-alist))))) - ;; does a newline go before the colon? Watch out for already - ;; non-hung colons. However, we don't unhang them because that - ;; would be a cleanup (and anti-social). - (if (and (memq 'before newlines) - (not is-scope-op) - (save-excursion - (skip-chars-backward ": \t") - (not (bolp)))) - (let ((pos (- (point-max) (point)))) - (forward-char -1) - (c-newline-and-indent) - (goto-char (- (point-max) pos)))) - ;; does a newline go after the colon? - (if (and (memq 'after (cdr-safe newlines)) - (not is-scope-op)) - (c-newline-and-indent)))) - (c--call-post-self-insert-hook-more-safely))) + (c-with-string-fences + (let* ((bod (c-point 'bod)) + (literal (c-save-buffer-state () (c-in-literal bod))) + newlines is-scope-op + ;; shut this up + (c-echo-syntactic-information-p nil)) + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + ;; Any electric action? + (if (and c-electric-flag (not literal) (not arg)) + ;; Unless we're at EOL, only re-indentation happens. + (if (not (looking-at "[ \t]*\\\\?$")) + (if c-syntactic-indentation + (indent-according-to-mode)) + + ;; scope-operator clean-up? + (let ((pos (- (point-max) (point))) + (here (point))) + (if (c-save-buffer-state () ; Why do we need this? [ACM, 2003-03-12] + (and c-auto-newline + (memq 'scope-operator c-cleanup-list) + (eq (char-before) ?:) + (progn + (forward-char -1) + (c-skip-ws-backward) + (eq (char-before) ?:)) + (not (c-in-literal)) + (not (eq (char-after (- (point) 2)) ?:)))) + (progn + (delete-region (point) (1- here)) + (setq is-scope-op t))) + (goto-char (- (point-max) pos))) + + ;; indent the current line if it's done syntactically. + (if c-syntactic-indentation + ;; Cannot use the same syntax analysis as we find below, + ;; since that's made with c-syntactic-indentation-in-macros + ;; always set to t. + (indent-according-to-mode)) + + ;; Calculate where, if anywhere, we want newlines. + (c-save-buffer-state + ((c-syntactic-indentation-in-macros t) + (c-auto-newline-analysis t) + ;; Turn on syntactic macro analysis to help with auto newlines + ;; only. + (syntax (c-guess-basic-syntax)) + (elem syntax)) + ;; Translate substatement-label to label for this operation. + (while elem + (if (eq (car (car elem)) 'substatement-label) + (setcar (car elem) 'label)) + (setq elem (cdr elem))) + ;; some language elements can only be determined by checking + ;; the following line. Let's first look for ones that can be + ;; found when looking on the line with the colon + (setq newlines + (and c-auto-newline + (or (c-lookup-lists '(case-label label access-label) + syntax c-hanging-colons-alist) + (c-lookup-lists '(member-init-intro inher-intro) + (progn + (insert ?\n) + (unwind-protect + (c-guess-basic-syntax) + (delete-char -1))) + c-hanging-colons-alist))))) + ;; does a newline go before the colon? Watch out for already + ;; non-hung colons. However, we don't unhang them because that + ;; would be a cleanup (and anti-social). + (if (and (memq 'before newlines) + (not is-scope-op) + (save-excursion + (skip-chars-backward ": \t") + (not (bolp)))) + (let ((pos (- (point-max) (point)))) + (forward-char -1) + (c-newline-and-indent) + (goto-char (- (point-max) pos)))) + ;; does a newline go after the colon? + (if (and (memq 'after (cdr-safe newlines)) + (not is-scope-op)) + (c-newline-and-indent)))))) + (c--call-post-self-insert-hook-more-safely)) (defun c-electric-lt-gt (arg) "Insert a \"<\" or \">\" character. @@ -1209,74 +1223,75 @@ finishes a C++ style stream operator in C++ mode. Exceptions are when a numeric argument is supplied, or the point is inside a literal." (interactive "*P") - (let ((literal (c-save-buffer-state () (c-in-literal))) - template-delim include-delim + (let (template-delim include-delim (c-echo-syntactic-information-p nil) final-pos found-delim case-fold-search) - (let (post-self-insert-hook) ; Disable random functionality. - (self-insert-command (prefix-numeric-value arg))) - (setq final-pos (point)) + (c-with-string-fences + (let (post-self-insert-hook) ; Disable random functionality. + (self-insert-command (prefix-numeric-value arg))) + (setq final-pos (point)) ;;;; 2010-01-31: There used to be code here to put a syntax-table text ;;;; property on the new < or > and its mate (if any) when they are template ;;;; parens. This is now done in an after-change function. - (when (and (not arg) (not literal)) - ;; Have we got a delimiter on a #include directive? - (beginning-of-line) - (setq include-delim - (and - (looking-at c-cpp-include-key) - (if (eq (c-last-command-char) ?<) - (eq (match-end 0) (1- final-pos)) - (goto-char (1- final-pos)) - (skip-chars-backward "^<>" (c-point 'bol)) - (eq (char-before) ?<)))) - (goto-char final-pos) - - ;; Indent the line if appropriate. - (when (and c-electric-flag c-syntactic-indentation c-recognize-<>-arglists) - (setq found-delim + (when (and (not arg) + (not (c-save-buffer-state () (c-in-literal)))) + ;; Have we got a delimiter on a #include directive? + (beginning-of-line) + (setq include-delim + (and + (looking-at c-cpp-include-key) (if (eq (c-last-command-char) ?<) - ;; If a <, basically see if it's got "template" before it ..... - (or (and (progn - (backward-char) - (= (point) - (progn (c-beginning-of-current-token) (point)))) - (progn - (c-backward-token-2) - (looking-at c-opt-<>-sexp-key)) - (setq template-delim t)) - ;; ..... or is a C++ << operator. - (and (c-major-mode-is 'c++-mode) - (progn - (goto-char (1- final-pos)) - (c-beginning-of-current-token) - (looking-at "<<")) - (>= (match-end 0) final-pos))) - - ;; It's a >. Either a template/generic terminator ... - (or (and (c-get-char-property (1- final-pos) 'syntax-table) - (setq template-delim t)) - ;; or a C++ >> operator. - (and (c-major-mode-is 'c++-mode) - (progn - (goto-char (1- final-pos)) - (c-beginning-of-current-token) - (looking-at ">>")) - (>= (match-end 0) final-pos))))) - (goto-char final-pos) - - (when found-delim - (indent-according-to-mode))) - - ;; On the off chance that < and > are configured as pairs in - ;; electric-pair-mode. - (when (and (boundp 'electric-pair-mode) electric-pair-mode - (or template-delim include-delim)) - (let (post-self-insert-hook) - (electric-pair-post-self-insert-function)))) + (eq (match-end 0) (1- final-pos)) + (goto-char (1- final-pos)) + (skip-chars-backward "^<>" (c-point 'bol)) + (eq (char-before) ?<)))) + (goto-char final-pos) + + ;; Indent the line if appropriate. + (when (and c-electric-flag c-syntactic-indentation c-recognize-<>-arglists) + (setq found-delim + (if (eq (c-last-command-char) ?<) + ;; If a <, basically see if it's got "template" before it ..... + (or (and (progn + (backward-char) + (= (point) + (progn (c-beginning-of-current-token) (point)))) + (progn + (c-backward-token-2) + (looking-at c-opt-<>-sexp-key)) + (setq template-delim t)) + ;; ..... or is a C++ << operator. + (and (c-major-mode-is 'c++-mode) + (progn + (goto-char (1- final-pos)) + (c-beginning-of-current-token) + (looking-at "<<")) + (>= (match-end 0) final-pos))) + + ;; It's a >. Either a template/generic terminator ... + (or (and (c-get-char-property (1- final-pos) 'syntax-table) + (setq template-delim t)) + ;; or a C++ >> operator. + (and (c-major-mode-is 'c++-mode) + (progn + (goto-char (1- final-pos)) + (c-beginning-of-current-token) + (looking-at ">>")) + (>= (match-end 0) final-pos))))) + (goto-char final-pos) + + (when found-delim + (indent-according-to-mode))))) + + ;; On the off chance that < and > are configured as pairs in + ;; electric-pair-mode. + (when (and (boundp 'electric-pair-mode) electric-pair-mode + (or template-delim include-delim)) + (let (post-self-insert-hook) + (electric-pair-post-self-insert-function))) (when found-delim (when (and (eq (char-before) ?>) @@ -1301,12 +1316,13 @@ removed; see the variable `c-cleanup-list'. Also, if `c-electric-flag' and `c-auto-newline' are both non-nil, some newline cleanups are done if appropriate; see the variable `c-cleanup-list'." (interactive "*P") - (let ((literal (c-save-buffer-state () (c-in-literal))) + (let ((literal (c-save-buffer-state () + (c-with-string-fences (c-in-literal)))) ;; shut this up (c-echo-syntactic-information-p nil) case-fold-search) (let (post-self-insert-hook) ; The only way to get defined functionality - ; from `self-insert-command'. + ; from `self-insert-command'. (self-insert-command (prefix-numeric-value arg))) (if (and (not arg) (not literal)) @@ -1315,46 +1331,47 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; afterwards. (old-blink-paren blink-paren-function) blink-paren-function) - (if (and c-syntactic-indentation c-electric-flag) - (indent-according-to-mode)) - - ;; If we're at EOL, check for new-line clean-ups. - (when (and c-electric-flag c-auto-newline - (looking-at "[ \t]*\\\\?$")) - - ;; clean up brace-elseif-brace - (when - (and (memq 'brace-elseif-brace c-cleanup-list) - (eq (c-last-command-char) ?\() - (re-search-backward - (concat "}" - "\\([ \t\n]\\|\\\\\n\\)*" - "else" - "\\([ \t\n]\\|\\\\\n\\)+" - "if" - "\\([ \t\n]\\|\\\\\n\\)*" - "(" - "\\=") - nil t) - (not (c-save-buffer-state () (c-in-literal)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert-and-inherit "} else if (")) - - ;; clean up brace-catch-brace - (when - (and (memq 'brace-catch-brace c-cleanup-list) - (eq (c-last-command-char) ?\() - (re-search-backward - (concat "}" - "\\([ \t\n]\\|\\\\\n\\)*" - "catch" - "\\([ \t\n]\\|\\\\\n\\)*" - "(" - "\\=") - nil t) - (not (c-save-buffer-state () (c-in-literal)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert-and-inherit "} catch ("))) + (c-with-string-fences + (if (and c-syntactic-indentation c-electric-flag) + (indent-according-to-mode)) + + ;; If we're at EOL, check for new-line clean-ups. + (when (and c-electric-flag c-auto-newline + (looking-at "[ \t]*\\\\?$")) + + ;; clean up brace-elseif-brace + (when + (and (memq 'brace-elseif-brace c-cleanup-list) + (eq (c-last-command-char) ?\() + (re-search-backward + (concat "}" + "\\([ \t\n]\\|\\\\\n\\)*" + "else" + "\\([ \t\n]\\|\\\\\n\\)+" + "if" + "\\([ \t\n]\\|\\\\\n\\)*" + "(" + "\\=") + nil t) + (not (c-save-buffer-state () (c-in-literal)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert-and-inherit "} else if (")) + + ;; clean up brace-catch-brace + (when + (and (memq 'brace-catch-brace c-cleanup-list) + (eq (c-last-command-char) ?\() + (re-search-backward + (concat "}" + "\\([ \t\n]\\|\\\\\n\\)*" + "catch" + "\\([ \t\n]\\|\\\\\n\\)*" + "(" + "\\=") + nil t) + (not (c-save-buffer-state () (c-in-literal)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert-and-inherit "} catch (")))) ;; Apply `electric-pair-mode' stuff. (when (and (boundp 'electric-pair-mode) @@ -1362,41 +1379,42 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." (let (post-self-insert-hook) (electric-pair-post-self-insert-function))) - ;; Check for clean-ups at function calls. These two DON'T need - ;; `c-electric-flag' or `c-syntactic-indentation' set. - ;; Point is currently just after the inserted paren. - (let (beg (end (1- (point)))) - (cond - - ;; space-before-funcall clean-up? - ((and (memq 'space-before-funcall c-cleanup-list) - (eq (c-last-command-char) ?\() - (save-excursion - (backward-char) - (skip-chars-backward " \t") - (setq beg (point)) - (and (c-save-buffer-state () (c-on-identifier)) - ;; Don't add a space into #define FOO().... - (not (and (c-beginning-of-macro) - (c-forward-over-cpp-define-id) - (eq (point) beg)))))) - (save-excursion - (delete-region beg end) - (goto-char beg) - (insert ?\ ))) - - ;; compact-empty-funcall clean-up? - ((c-save-buffer-state () - (and (memq 'compact-empty-funcall c-cleanup-list) - (eq (c-last-command-char) ?\)) - (save-excursion - (c-safe (backward-char 2)) - (when (looking-at "()") - (setq end (point)) - (skip-chars-backward " \t") - (setq beg (point)) - (c-on-identifier))))) - (delete-region beg end)))) + (c-with-string-fences + ;; Check for clean-ups at function calls. These two DON'T need + ;; `c-electric-flag' or `c-syntactic-indentation' set. + ;; Point is currently just after the inserted paren. + (let (beg (end (1- (point)))) + (cond + + ;; space-before-funcall clean-up? + ((and (memq 'space-before-funcall c-cleanup-list) + (eq (c-last-command-char) ?\() + (save-excursion + (backward-char) + (skip-chars-backward " \t") + (setq beg (point)) + (and (c-save-buffer-state () (c-on-identifier)) + ;; Don't add a space into #define FOO().... + (not (and (c-beginning-of-macro) + (c-forward-over-cpp-define-id) + (eq (point) beg)))))) + (save-excursion + (delete-region beg end) + (goto-char beg) + (insert ?\ ))) + + ;; compact-empty-funcall clean-up? + ((c-save-buffer-state () + (and (memq 'compact-empty-funcall c-cleanup-list) + (eq (c-last-command-char) ?\)) + (save-excursion + (c-safe (backward-char 2)) + (when (looking-at "()") + (setq end (point)) + (skip-chars-backward " \t") + (setq beg (point)) + (c-on-identifier))))) + (delete-region beg end))))) (and (eq last-input-event ?\)) (not executing-kbd-macro) old-blink-paren @@ -1405,8 +1423,8 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; Apply `electric-pair-mode' stuff inside a string or comment. (when (and (boundp 'electric-pair-mode) electric-pair-mode) (let (post-self-insert-hook) - (electric-pair-post-self-insert-function)))) - (c--call-post-self-insert-hook-more-safely))) + (electric-pair-post-self-insert-function))))) + (c--call-post-self-insert-hook-more-safely)) (defun c-electric-continued-statement () "Reindent the current line if appropriate. @@ -1868,70 +1886,71 @@ defun." (c-region-is-active-p) (push-mark)) - (c-save-buffer-state - (beginning-of-defun-function - end-of-defun-function - (paren-state (c-parse-state)) - (orig-point-min (point-min)) (orig-point-max (point-max)) - lim ; Position of { which has been widened to. - where pos case-fold-search) - - (save-restriction - (if (eq c-defun-tactic 'go-outward) - (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace. - paren-state orig-point-min orig-point-max))) - - ;; Move back out of any macro/comment/string we happen to be in. - (c-beginning-of-macro) - (setq pos (c-literal-start)) - (if pos (goto-char pos)) - - (setq where (c-where-wrt-brace-construct)) - - (if (< arg 0) - ;; Move forward to the closing brace of a function. - (progn - (if (memq where '(at-function-end outwith-function)) - (setq arg (1+ arg))) - (if (< arg 0) - (c-while-widening-to-decl-block - (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0))) - (prog1 - ;; Move forward to the next opening brace.... - (when (and (= arg 0) - (progn - (c-while-widening-to-decl-block - (not (c-syntactic-re-search-forward "{" nil 'eob))) - (eq (char-before) ?{))) - (backward-char) - ;; ... and backward to the function header. - (c-beginning-of-decl-1) - t) - (c-keep-region-active))) - - ;; Move backward to the opening brace of a function, making successively - ;; larger portions of the buffer visible as necessary. - (when (> arg 0) - (c-while-widening-to-decl-block - (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0))) - - (when (eq arg 0) - ;; Go backward to this function's header. - (c-beginning-of-decl-1) - - (setq pos (point)) - ;; We're now there, modulo comments and whitespace. - ;; Try to be line oriented; position point at the closest - ;; preceding boi that isn't inside a comment, but if we hit - ;; the previous declaration then we use the current point - ;; instead. - (while (and (/= (point) (c-point 'boi)) - (c-backward-single-comment))) - (if (/= (point) (c-point 'boi)) - (goto-char pos))) - - (c-keep-region-active) - (= arg 0))))) + (c-with-string-fences + (c-save-buffer-state + (beginning-of-defun-function + end-of-defun-function + (paren-state (c-parse-state)) + (orig-point-min (point-min)) (orig-point-max (point-max)) + lim ; Position of { which has been widened to. + where pos case-fold-search) + + (save-restriction + (if (eq c-defun-tactic 'go-outward) + (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace. + paren-state orig-point-min orig-point-max))) + + ;; Move back out of any macro/comment/string we happen to be in. + (c-beginning-of-macro) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) + + (setq where (c-where-wrt-brace-construct)) + + (if (< arg 0) + ;; Move forward to the closing brace of a function. + (progn + (if (memq where '(at-function-end outwith-function)) + (setq arg (1+ arg))) + (if (< arg 0) + (c-while-widening-to-decl-block + (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0))) + (prog1 + ;; Move forward to the next opening brace.... + (when (and (= arg 0) + (progn + (c-while-widening-to-decl-block + (not (c-syntactic-re-search-forward "{" nil 'eob))) + (eq (char-before) ?{))) + (backward-char) + ;; ... and backward to the function header. + (c-beginning-of-decl-1) + t) + (c-keep-region-active))) + + ;; Move backward to the opening brace of a function, making successively + ;; larger portions of the buffer visible as necessary. + (when (> arg 0) + (c-while-widening-to-decl-block + (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0))) + + (when (eq arg 0) + ;; Go backward to this function's header. + (c-beginning-of-decl-1) + + (setq pos (point)) + ;; We're now there, modulo comments and whitespace. + ;; Try to be line oriented; position point at the closest + ;; preceding boi that isn't inside a comment, but if we hit + ;; the previous declaration then we use the current point + ;; instead. + (while (and (/= (point) (c-point 'boi)) + (c-backward-single-comment))) + (if (/= (point) (c-point 'boi)) + (goto-char pos))) + + (c-keep-region-active) + (= arg 0)))))) (defun c-forward-to-nth-EOF-\;-or-} (n where) ;; Skip to the closing brace or semicolon of the Nth function after point. @@ -1998,65 +2017,66 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (c-region-is-active-p) (push-mark)) - (c-save-buffer-state - (beginning-of-defun-function - end-of-defun-function - (paren-state (c-parse-state)) - (orig-point-min (point-min)) (orig-point-max (point-max)) - lim - where pos case-fold-search) - - (save-restriction - (if (eq c-defun-tactic 'go-outward) - (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace - paren-state orig-point-min orig-point-max))) - - ;; Move back out of any macro/comment/string we happen to be in. - (c-beginning-of-macro) - (setq pos (c-literal-start)) - (if pos (goto-char pos)) + (c-with-string-fences + (c-save-buffer-state + (beginning-of-defun-function + end-of-defun-function + (paren-state (c-parse-state)) + (orig-point-min (point-min)) (orig-point-max (point-max)) + lim + where pos case-fold-search) + + (save-restriction + (if (eq c-defun-tactic 'go-outward) + (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace + paren-state orig-point-min orig-point-max))) + + ;; Move back out of any macro/comment/string we happen to be in. + (c-beginning-of-macro) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) + + (setq where (c-where-wrt-brace-construct)) + + (if (< arg 0) + ;; Move backwards to the } of a function + (progn + (if (memq where '(at-header outwith-function)) + (setq arg (1+ arg))) + (if (< arg 0) + (c-while-widening-to-decl-block + (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0))) + (if (= arg 0) + (c-while-widening-to-decl-block + (progn (c-syntactic-skip-backward "^}") + (not (eq (char-before) ?})))))) + + ;; Move forward to the } of a function + (if (> arg 0) + (c-while-widening-to-decl-block + (> (setq arg (c-forward-to-nth-EOF-\;-or-} arg where)) 0)))) + + ;; Do we need to move forward from the brace to the semicolon? + (when (eq arg 0) + (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc. + (c-syntactic-re-search-forward ";")) - (setq where (c-where-wrt-brace-construct)) + (setq pos (point)) + ;; We're there now, modulo comments and whitespace. + ;; Try to be line oriented; position point after the next + ;; newline that isn't inside a comment, but if we hit the + ;; next declaration then we use the current point instead. + (while (and (not (bolp)) + (not (looking-at "\\s *$")) + (c-forward-single-comment))) + (cond ((bolp)) + ((looking-at "\\s *$") + (forward-line 1)) + (t + (goto-char pos)))) - (if (< arg 0) - ;; Move backwards to the } of a function - (progn - (if (memq where '(at-header outwith-function)) - (setq arg (1+ arg))) - (if (< arg 0) - (c-while-widening-to-decl-block - (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0))) - (if (= arg 0) - (c-while-widening-to-decl-block - (progn (c-syntactic-skip-backward "^}") - (not (eq (char-before) ?})))))) - - ;; Move forward to the } of a function - (if (> arg 0) - (c-while-widening-to-decl-block - (> (setq arg (c-forward-to-nth-EOF-\;-or-} arg where)) 0)))) - - ;; Do we need to move forward from the brace to the semicolon? - (when (eq arg 0) - (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc. - (c-syntactic-re-search-forward ";")) - - (setq pos (point)) - ;; We're there now, modulo comments and whitespace. - ;; Try to be line oriented; position point after the next - ;; newline that isn't inside a comment, but if we hit the - ;; next declaration then we use the current point instead. - (while (and (not (bolp)) - (not (looking-at "\\s *$")) - (c-forward-single-comment))) - (cond ((bolp)) - ((looking-at "\\s *$") - (forward-line 1)) - (t - (goto-char pos)))) - - (c-keep-region-active) - (= arg 0)))) + (c-keep-region-active) + (= arg 0))))) (defun c-defun-name-1 () "Return name of current defun, at current narrowing, or nil if there isn't one. @@ -2095,13 +2115,12 @@ with a brace block." (c-forward-syntactic-ws) (when (eq (char-after) ?\") (forward-sexp 1) + (c-forward-syntactic-ws) (c-forward-token-2)) ; over the comma and following WS. - (buffer-substring-no-properties - (point) - (progn - (c-forward-token-2) - (c-backward-syntactic-ws) - (point)))) + (setq pos (point)) + (and (zerop (c-forward-token-2)) + (progn (c-backward-syntactic-ws) t) + (buffer-substring-no-properties pos (point)))) ((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method ;; Move to the beginning of the method name. @@ -2342,18 +2361,19 @@ with a brace block, at the outermost level of nesting." "Display the name of the current CC mode defun and the position in it. With a prefix arg, push the name onto the kill ring too." (interactive "P") - (save-restriction - (widen) - (c-save-buffer-state ((name-and-limits (c-defun-name-and-limits nil)) - (name (car name-and-limits)) - (limits (cdr name-and-limits)) - (point-bol (c-point 'bol))) - (when name - (message "%s. Line %s/%s." name - (1+ (count-lines (car limits) (max point-bol (car limits)))) - (count-lines (car limits) (cdr limits))) - (if arg (kill-new name)) - (sit-for 3 t))))) + (c-with-string-fences + (save-restriction + (widen) + (c-save-buffer-state ((name-and-limits (c-defun-name-and-limits nil)) + (name (car name-and-limits)) + (limits (cdr name-and-limits)) + (point-bol (c-point 'bol))) + (when name + (message "%s. Line %s/%s." name + (1+ (count-lines (car limits) (max point-bol (car limits)))) + (count-lines (car limits) (cdr limits))) + (if arg (kill-new name)) + (sit-for 3 t)))))) (put 'c-display-defun-name 'isearch-scroll t) (defun c-mark-function () @@ -2369,34 +2389,35 @@ As opposed to \\[c-beginning-of-defun] and \\[c-end-of-defun], this function does not require the declaration to contain a brace block." (interactive) - (let (decl-limits case-fold-search) - (c-save-buffer-state nil - ;; We try to be line oriented, unless there are several - ;; declarations on the same line. - (if (looking-at c-syntactic-eol) - (c-backward-token-2 1 nil (c-point 'bol))) - (setq decl-limits (c-declaration-limits t))) - - (if (not decl-limits) - (error "Cannot find any declaration") - (let* ((extend-region-p - (and (eq this-command 'c-mark-function) - (eq last-command 'c-mark-function))) - (push-mark-p (and (eq this-command 'c-mark-function) - (not extend-region-p) - (not (c-region-is-active-p))))) - (if push-mark-p (push-mark)) - (if extend-region-p - (progn - (exchange-point-and-mark) - (setq decl-limits (c-declaration-limits t)) - (when (not decl-limits) - (exchange-point-and-mark) - (error "Cannot find any declaration")) - (goto-char (cdr decl-limits)) - (exchange-point-and-mark)) - (goto-char (car decl-limits)) - (push-mark (cdr decl-limits) nil t)))))) + (c-with-string-fences + (let (decl-limits case-fold-search) + (c-save-buffer-state nil + ;; We try to be line oriented, unless there are several + ;; declarations on the same line. + (if (looking-at c-syntactic-eol) + (c-backward-token-2 1 nil (c-point 'bol))) + (setq decl-limits (c-declaration-limits t))) + + (if (not decl-limits) + (error "Cannot find any declaration") + (let* ((extend-region-p + (and (eq this-command 'c-mark-function) + (eq last-command 'c-mark-function))) + (push-mark-p (and (eq this-command 'c-mark-function) + (not extend-region-p) + (not (c-region-is-active-p))))) + (if push-mark-p (push-mark)) + (if extend-region-p + (progn + (exchange-point-and-mark) + (setq decl-limits (c-declaration-limits t)) + (when (not decl-limits) + (exchange-point-and-mark) + (error "Cannot find any declaration")) + (goto-char (cdr decl-limits)) + (exchange-point-and-mark)) + (goto-char (car decl-limits)) + (push-mark (cdr decl-limits) nil t))))))) (defun c-cpp-define-name () "Return the name of the current CPP macro, or NIL if we're not in one." @@ -3033,85 +3054,86 @@ be more \"DWIM:ey\"." nil t)) (if (< count 0) (c-end-of-statement (- count) lim sentence-flag) - (c-save-buffer-state - ((count (or count 1)) - last ; start point for going back ONE chunk. Updated each chunk movement. - (macro-fence - (save-excursion (and (not (bobp)) (c-beginning-of-macro) (point)))) - res ; result from sub-function call - not-bos ; "not beginning-of-statement" - (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL - - ;; Go back one statement at each iteration of the following loop. - (while (and (/= count 0) - (or (not lim) (> (point) lim))) - ;; Go back one "chunk" each time round the following loop, stopping - ;; when we reach a statement boundary, etc. - (setq last (point)) - (while - (cond ; Each arm of this cond returns NIL on reaching a desired - ; statement boundary, non-NIL otherwise. - ((bobp) - (setq count 0) - nil) - - (range ; point is within or approaching a literal. - (cond - ;; Single line string or sentence-flag is null => skip the - ;; entire literal. - ((or (null sentence-flag) - (c-one-line-string-p range)) - (goto-char (car range)) - (setq range (c-ascertain-preceding-literal)) - ;; N.B. The following is essentially testing for an AWK regexp - ;; at BOS: - ;; Was the previous non-ws thing an end of statement? - (save-excursion - (if macro-fence - (c-backward-comments) - (c-backward-syntactic-ws)) - (not (or (bobp) (c-after-statement-terminator-p))))) - - ;; Comment inside a statement or a multi-line string. - (t (when (setq res ; returns non-nil when we go out of the literal - (if (eq (c-literal-type range) 'string) - (c-beginning-of-sentence-in-string range) - (c-beginning-of-sentence-in-comment range))) - (setq range (c-ascertain-preceding-literal))) - res))) - - ;; Non-literal code. - (t (setq res (c-back-over-illiterals macro-fence)) - (setq not-bos ; "not reached beginning-of-statement". - (or (= (point) last) - (memq (char-after) '(?\) ?\})) - (and - (car res) - ;; We're at a tentative BOS. The next form goes - ;; back over WS looking for an end of previous - ;; statement. - (not (save-excursion - (if macro-fence - (c-backward-comments) - (c-backward-syntactic-ws)) - (or (bobp) (c-after-statement-terminator-p))))))) - ;; Are we about to move backwards into or out of a - ;; preprocessor command? If so, locate its beginning. - (when (eq (cdr res) 'macro-boundary) - (save-excursion - (beginning-of-line) - (setq macro-fence - (and (not (bobp)) - (progn (c-skip-ws-backward) (c-beginning-of-macro)) - (point))))) - ;; Are we about to move backwards into a literal? - (when (memq (cdr res) '(macro-boundary literal)) - (setq range (c-ascertain-preceding-literal))) - not-bos)) - (setq last (point))) - - (if (/= count 0) (setq count (1- count)))) - (c-keep-region-active)))) + (c-with-string-fences + (c-save-buffer-state + ((count (or count 1)) + last ; start point for going back ONE chunk. Updated each chunk movement. + (macro-fence + (save-excursion (and (not (bobp)) (c-beginning-of-macro) (point)))) + res ; result from sub-function call + not-bos ; "not beginning-of-statement" + (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL + + ;; Go back one statement at each iteration of the following loop. + (while (and (/= count 0) + (or (not lim) (> (point) lim))) + ;; Go back one "chunk" each time round the following loop, stopping + ;; when we reach a statement boundary, etc. + (setq last (point)) + (while + (cond ; Each arm of this cond returns NIL on reaching a desired + ; statement boundary, non-NIL otherwise. + ((bobp) + (setq count 0) + nil) + + (range ; point is within or approaching a literal. + (cond + ;; Single line string or sentence-flag is null => skip the + ;; entire literal. + ((or (null sentence-flag) + (c-one-line-string-p range)) + (goto-char (car range)) + (setq range (c-ascertain-preceding-literal)) + ;; N.B. The following is essentially testing for an AWK regexp + ;; at BOS: + ;; Was the previous non-ws thing an end of statement? + (save-excursion + (if macro-fence + (c-backward-comments) + (c-backward-syntactic-ws)) + (not (or (bobp) (c-after-statement-terminator-p))))) + + ;; Comment inside a statement or a multi-line string. + (t (when (setq res ; returns non-nil when we go out of the literal + (if (eq (c-literal-type range) 'string) + (c-beginning-of-sentence-in-string range) + (c-beginning-of-sentence-in-comment range))) + (setq range (c-ascertain-preceding-literal))) + res))) + + ;; Non-literal code. + (t (setq res (c-back-over-illiterals macro-fence)) + (setq not-bos ; "not reached beginning-of-statement". + (or (= (point) last) + (memq (char-after) '(?\) ?\})) + (and + (car res) + ;; We're at a tentative BOS. The next form goes + ;; back over WS looking for an end of previous + ;; statement. + (not (save-excursion + (if macro-fence + (c-backward-comments) + (c-backward-syntactic-ws)) + (or (bobp) (c-after-statement-terminator-p))))))) + ;; Are we about to move backwards into or out of a + ;; preprocessor command? If so, locate its beginning. + (when (eq (cdr res) 'macro-boundary) + (save-excursion + (beginning-of-line) + (setq macro-fence + (and (not (bobp)) + (progn (c-skip-ws-backward) (c-beginning-of-macro)) + (point))))) + ;; Are we about to move backwards into a literal? + (when (memq (cdr res) '(macro-boundary literal)) + (setq range (c-ascertain-preceding-literal))) + not-bos)) + (setq last (point))) + + (if (/= count 0) (setq count (1- count)))) + (c-keep-region-active))))) (defun c-end-of-statement (&optional count lim sentence-flag) "Go to the end of the innermost C statement. @@ -3129,78 +3151,79 @@ sentence motion in or near comments and multiline strings." (setq count (or count 1)) (if (< count 0) (c-beginning-of-statement (- count) lim sentence-flag) - (c-save-buffer-state - (here ; start point for going forward ONE statement. Updated each statement. - (macro-fence - (save-excursion - (and (not (eobp)) (c-beginning-of-macro) - (progn (c-end-of-macro) (point))))) - res - (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL - - ;; Go back/forward one statement at each iteration of the following loop. - (while (and (/= count 0) - (or (not lim) (< (point) lim))) - (setq here (point)) ; ONLY HERE is HERE updated - - ;; Go forward one "chunk" each time round the following loop, stopping - ;; when we reach a statement boundary, etc. - (while - (cond ; Each arm of this cond returns NIL on reaching a desired - ; statement boundary, non-NIL otherwise. - ((eobp) - (setq count 0) - nil) + (c-with-string-fences + (c-save-buffer-state + (here ; start point for going forward ONE statement. Updated each statement. + (macro-fence + (save-excursion + (and (not (eobp)) (c-beginning-of-macro) + (progn (c-end-of-macro) (point))))) + res + (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL + + ;; Go back/forward one statement at each iteration of the following loop. + (while (and (/= count 0) + (or (not lim) (< (point) lim))) + (setq here (point)) ; ONLY HERE is HERE updated + + ;; Go forward one "chunk" each time round the following loop, stopping + ;; when we reach a statement boundary, etc. + (while + (cond ; Each arm of this cond returns NIL on reaching a desired + ; statement boundary, non-NIL otherwise. + ((eobp) + (setq count 0) + nil) + + (range ; point is within a literal. + (cond + ;; sentence-flag is null => skip the entire literal. + ;; or a Single line string. + ((or (null sentence-flag) + (c-one-line-string-p range)) + (goto-char (cdr range)) + (setq range (c-ascertain-following-literal)) + ;; Is there a virtual semicolon here (e.g. for AWK)? + (not (c-at-vsemi-p))) + + ;; Comment or multi-line string. + (t (when (setq res ; gets non-nil when we go out of the literal + (if (eq (c-literal-type range) 'string) + (c-end-of-sentence-in-string range) + (c-end-of-sentence-in-comment range))) + (setq range (c-ascertain-following-literal))) + ;; If we've just come forward out of a literal, check for + ;; vsemi. (N.B. AWK can't have a vsemi after a comment, but + ;; some other language may do in the future) + (and res + (not (c-at-vsemi-p)))))) + + ;; Non-literal code. + (t (setq res (c-forward-over-illiterals macro-fence + (> (point) here))) + ;; Are we about to move forward into or out of a + ;; preprocessor command? + (when (eq (cdr res) 'macro-boundary) + (setq macro-fence + (save-excursion + (if macro-fence + (progn + (end-of-line) + (and (not (eobp)) + (progn (c-skip-ws-forward) + (c-beginning-of-macro)) + (progn (c-end-of-macro) + (point)))) + (and (not (eobp)) + (c-beginning-of-macro) + (progn (c-end-of-macro) (point))))))) + ;; Are we about to move forward into a literal? + (when (memq (cdr res) '(macro-boundary literal)) + (setq range (c-ascertain-following-literal))) + (car res)))) - (range ; point is within a literal. - (cond - ;; sentence-flag is null => skip the entire literal. - ;; or a Single line string. - ((or (null sentence-flag) - (c-one-line-string-p range)) - (goto-char (cdr range)) - (setq range (c-ascertain-following-literal)) - ;; Is there a virtual semicolon here (e.g. for AWK)? - (not (c-at-vsemi-p))) - - ;; Comment or multi-line string. - (t (when (setq res ; gets non-nil when we go out of the literal - (if (eq (c-literal-type range) 'string) - (c-end-of-sentence-in-string range) - (c-end-of-sentence-in-comment range))) - (setq range (c-ascertain-following-literal))) - ;; If we've just come forward out of a literal, check for - ;; vsemi. (N.B. AWK can't have a vsemi after a comment, but - ;; some other language may do in the future) - (and res - (not (c-at-vsemi-p)))))) - - ;; Non-literal code. - (t (setq res (c-forward-over-illiterals macro-fence - (> (point) here))) - ;; Are we about to move forward into or out of a - ;; preprocessor command? - (when (eq (cdr res) 'macro-boundary) - (setq macro-fence - (save-excursion - (if macro-fence - (progn - (end-of-line) - (and (not (eobp)) - (progn (c-skip-ws-forward) - (c-beginning-of-macro)) - (progn (c-end-of-macro) - (point)))) - (and (not (eobp)) - (c-beginning-of-macro) - (progn (c-end-of-macro) (point))))))) - ;; Are we about to move forward into a literal? - (when (memq (cdr res) '(macro-boundary literal)) - (setq range (c-ascertain-following-literal))) - (car res)))) - - (if (/= count 0) (setq count (1- count)))) - (c-keep-region-active)))) + (if (/= count 0) (setq count (1- count)))) + (c-keep-region-active))))) ;; set up electric character functions to work with pending-del, @@ -3539,122 +3562,125 @@ prefix argument is equivalent to -1. depending on the variable `indent-tabs-mode'." (interactive "P") - (let ((indent-function - (if c-syntactic-indentation - (symbol-function 'indent-according-to-mode) - (lambda () - (let ((c-macro-start c-macro-start) - (steps (if (equal arg '(4)) - -1 - (prefix-numeric-value arg)))) - (c-shift-line-indentation (* steps c-basic-offset)) - (when (and c-auto-align-backslashes - (save-excursion - (end-of-line) - (eq (char-before) ?\\)) - (c-query-and-set-macro-start)) - ;; Realign the line continuation backslash if inside a macro. - (c-backslash-region (point) (point) nil t))) - )))) - (if (and c-syntactic-indentation arg) - ;; If c-syntactic-indentation and got arg, always indent this - ;; line as C and shift remaining lines of expression the same - ;; amount. - (let ((shift-amt (save-excursion - (back-to-indentation) - (current-column))) - beg end) - (c-indent-line) - (setq shift-amt (- (save-excursion - (back-to-indentation) - (current-column)) - shift-amt)) - (save-excursion - (if (eq c-tab-always-indent t) - (beginning-of-line)) ; FIXME!!! What is this here for? ACM 2005/10/31 - (setq beg (point)) - (c-forward-sexp 1) - (setq end (point)) - (goto-char beg) - (forward-line 1) - (setq beg (point))) - (if (> end beg) - (indent-code-rigidly beg end shift-amt "#"))) - ;; Else use c-tab-always-indent to determine behavior. - (cond - ;; CASE 1: indent when at column zero or in line's indentation, - ;; otherwise insert a tab - ((not c-tab-always-indent) - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (funcall c-insert-tab-function) - (funcall indent-function))) - ;; CASE 2: just indent the line - ((eq c-tab-always-indent t) - (funcall indent-function)) - ;; CASE 3: if in a literal, insert a tab, but always indent the - ;; line - (t - (if (c-save-buffer-state () (c-in-literal)) - (funcall c-insert-tab-function)) - (funcall indent-function) - ))))) + (c-with-string-fences + (let ((indent-function + (if c-syntactic-indentation + (symbol-function 'indent-according-to-mode) + (lambda () + (let ((c-macro-start c-macro-start) + (steps (if (equal arg '(4)) + -1 + (prefix-numeric-value arg)))) + (c-shift-line-indentation (* steps c-basic-offset)) + (when (and c-auto-align-backslashes + (save-excursion + (end-of-line) + (eq (char-before) ?\\)) + (c-query-and-set-macro-start)) + ;; Realign the line continuation backslash if inside a macro. + (c-backslash-region (point) (point) nil t))) + )))) + (if (and c-syntactic-indentation arg) + ;; If c-syntactic-indentation and got arg, always indent this + ;; line as C and shift remaining lines of expression the same + ;; amount. + (let ((shift-amt (save-excursion + (back-to-indentation) + (current-column))) + beg end) + (c-indent-line) + (setq shift-amt (- (save-excursion + (back-to-indentation) + (current-column)) + shift-amt)) + (save-excursion + (if (eq c-tab-always-indent t) + (beginning-of-line)) ; FIXME!!! What is this here for? ACM 2005/10/31 + (setq beg (point)) + (c-forward-sexp 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end shift-amt "#"))) + ;; Else use c-tab-always-indent to determine behavior. + (cond + ;; CASE 1: indent when at column zero or in line's indentation, + ;; otherwise insert a tab + ((not c-tab-always-indent) + (if (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (funcall c-insert-tab-function) + (funcall indent-function))) + ;; CASE 2: just indent the line + ((eq c-tab-always-indent t) + (funcall indent-function)) + ;; CASE 3: if in a literal, insert a tab, but always indent the + ;; line + (t + (if (c-save-buffer-state () (c-in-literal)) + (funcall c-insert-tab-function)) + (funcall indent-function) + )))))) (defun c-indent-exp (&optional shutup-p) "Indent each line in the balanced expression following point syntactically. If optional SHUTUP-P is non-nil, no errors are signaled if no balanced expression is found." (interactive "*P") - (let ((here (point-marker)) - end) - (set-marker-insertion-type here t) - (unwind-protect - (let ((start (save-restriction - ;; Find the closest following open paren that - ;; ends on another line. - (narrow-to-region (point-min) (c-point 'eol)) - (let (beg (end (point))) - (while (and (setq beg (c-down-list-forward end)) - (setq end (c-up-list-forward beg)))) - (and beg - (eq (char-syntax (char-before beg)) ?\() - (1- beg)))))) - ;; sanity check - (if (not start) - (unless shutup-p - (error "Cannot find start of balanced expression to indent")) - (goto-char start) - (setq end (c-safe (scan-sexps (point) 1))) - (if (not end) - (unless shutup-p - (error "Cannot find end of balanced expression to indent")) - (forward-line) - (if (< (point) end) - (c-indent-region (point) end))))) - (goto-char here) - (set-marker here nil)))) + (c-with-string-fences + (let ((here (point-marker)) + end) + (set-marker-insertion-type here t) + (unwind-protect + (let ((start (save-restriction + ;; Find the closest following open paren that + ;; ends on another line. + (narrow-to-region (point-min) (c-point 'eol)) + (let (beg (end (point))) + (while (and (setq beg (c-down-list-forward end)) + (setq end (c-up-list-forward beg)))) + (and beg + (eq (char-syntax (char-before beg)) ?\() + (1- beg)))))) + ;; sanity check + (if (not start) + (unless shutup-p + (error "Cannot find start of balanced expression to indent")) + (goto-char start) + (setq end (c-safe (scan-sexps (point) 1))) + (if (not end) + (unless shutup-p + (error "Cannot find end of balanced expression to indent")) + (forward-line) + (if (< (point) end) + (c-indent-region (point) end))))) + (goto-char here) + (set-marker here nil))))) (defun c-indent-defun () "Indent the current top-level declaration or macro syntactically. In the macro case this also has the effect of realigning any line continuation backslashes, unless `c-auto-align-backslashes' is nil." (interactive "*") - (let ((here (point-marker)) decl-limits case-fold-search) - (unwind-protect - (progn - (c-save-buffer-state nil - ;; We try to be line oriented, unless there are several - ;; declarations on the same line. - (if (looking-at c-syntactic-eol) - (c-backward-token-2 1 nil (c-point 'bol)) - (c-forward-token-2 0 nil (c-point 'eol))) - (setq decl-limits (c-declaration-limits nil))) - (if decl-limits - (c-indent-region (car decl-limits) - (cdr decl-limits)))) - (goto-char here) - (set-marker here nil)))) + (c-with-string-fences + (let ((here (point-marker)) decl-limits case-fold-search) + (unwind-protect + (progn + (c-save-buffer-state nil + ;; We try to be line oriented, unless there are several + ;; declarations on the same line. + (if (looking-at c-syntactic-eol) + (c-backward-token-2 1 nil (c-point 'bol)) + (c-forward-token-2 0 nil (c-point 'eol))) + (setq decl-limits (c-declaration-limits nil))) + (if decl-limits + (c-indent-region (car decl-limits) + (cdr decl-limits)))) + (goto-char here) + (set-marker here nil))))) (defun c-indent-region (start end &optional quiet) "Indent syntactically lines whose first char is between START and END inclusive. @@ -3734,9 +3760,10 @@ starting on the current line. Otherwise reindent just the current line." (interactive (list current-prefix-arg (c-region-is-active-p))) - (if region - (c-indent-region (region-beginning) (region-end)) - (c-indent-command arg))) + (c-with-string-fences + (if region + (c-indent-region (region-beginning) (region-end)) + (c-indent-command arg)))) ;; for progress reporting (defvar c-progress-info nil) @@ -4823,15 +4850,16 @@ If point is in any other situation, i.e. in normal code, do nothing. Optional prefix ARG means justify paragraph as well." (interactive "*P") - (let ((fill-paragraph-function - ;; Avoid infinite recursion. - (if (not (eq fill-paragraph-function 'c-fill-paragraph)) - fill-paragraph-function))) - (c-mask-paragraph t nil 'fill-paragraph arg)) - ;; Always return t. This has the effect that if filling isn't done - ;; above, it isn't done at all, and it's therefore effectively - ;; disabled in normal code. - t) + (c-with-string-fences + (let ((fill-paragraph-function + ;; Avoid infinite recursion. + (if (not (eq fill-paragraph-function 'c-fill-paragraph)) + fill-paragraph-function))) + (c-mask-paragraph t nil 'fill-paragraph arg)) + ;; Always return t. This has the effect that if filling isn't done + ;; above, it isn't done at all, and it's therefore effectively + ;; disabled in normal code. + t)) (defun c-do-auto-fill () ;; Do automatic filling if not inside a context where it should be @@ -4863,181 +4891,170 @@ If a fill prefix is specified, it overrides all the above." ;; used from auto-fill itself, that's normally disabled to avoid ;; unnecessary recursion. (interactive) - (let ((fill-prefix fill-prefix) - (do-line-break - (lambda () - (delete-horizontal-space) - (if soft - (insert-and-inherit ?\n) - (newline (if allow-auto-fill nil 1))))) - ;; Already know the literal type and limits when called from - ;; c-context-line-break. - (c-lit-limits c-lit-limits) - (c-lit-type c-lit-type) - (c-macro-start c-macro-start)) - - (c-save-buffer-state () - (when (not (eq c-auto-fill-prefix t)) - ;; Called from do-auto-fill. - (unless c-lit-limits - (setq c-lit-limits (c-literal-limits nil nil t))) - (unless c-lit-type - (setq c-lit-type (c-literal-type c-lit-limits))) - (if (memq (cond ((c-query-and-set-macro-start) 'cpp) - ((null c-lit-type) 'code) - (t c-lit-type)) - c-ignore-auto-fill) - (setq fill-prefix t) ; Used as flag in the cond. - (if (and (null c-auto-fill-prefix) - (eq c-lit-type 'c) - (<= (c-point 'bol) (car c-lit-limits))) - ;; The adaptive fill function has generated a prefix, but - ;; we're on the first line in a block comment so it'll be - ;; wrong. Ignore it to guess a better one below. - (setq fill-prefix nil) - (when (and (eq c-lit-type 'c++) - (not (string-match (concat "\\`[ \t]*" - c-line-comment-starter) - (or fill-prefix "")))) - ;; Kludge: If the function that adapted the fill prefix - ;; doesn't produce the required comment starter for line - ;; comments, then we ignore it. - (setq fill-prefix nil))) - ))) - - (cond ((eq fill-prefix t) - ;; A call from do-auto-fill which should be ignored. - ) - (fill-prefix - ;; A fill-prefix overrides anything. - (funcall do-line-break) - (insert-and-inherit fill-prefix)) - ((c-save-buffer-state () - (unless c-lit-limits - (setq c-lit-limits (c-literal-limits))) - (unless c-lit-type - (setq c-lit-type (c-literal-type c-lit-limits))) - (memq c-lit-type '(c c++))) - ;; Some sort of comment. - (if (or comment-multi-line - (save-excursion - (goto-char (car c-lit-limits)) - (end-of-line) - (< (point) (cdr c-lit-limits)))) - ;; Inside a comment that should be continued. - (let ((fill (c-save-buffer-state nil - (c-guess-fill-prefix - (setq c-lit-limits - (c-collect-line-comments c-lit-limits)) - c-lit-type))) - (pos (point)) - (comment-text-end - (or (and (eq c-lit-type 'c) - (save-excursion - (goto-char (- (cdr c-lit-limits) 2)) - (if (looking-at "\\*/") (point)))) - (cdr c-lit-limits)))) - ;; Skip forward past the fill prefix in case - ;; we're standing in it. - ;; - ;; FIXME: This doesn't work well in cases like - ;; - ;; /* Bla bla bla bla bla - ;; bla bla - ;; - ;; If point is on the 'B' then the line will be - ;; broken after "Bla b". - ;; - ;; If we have an empty comment, /* */, the next - ;; lot of code pushes point to the */. We fix - ;; this by never allowing point to end up to the - ;; right of where it started. - (while (and (< (current-column) (cdr fill)) - (not (eolp))) - (forward-char 1)) - (if (and (> (point) comment-text-end) - (> (c-point 'bol) (car c-lit-limits))) - (progn - ;; The skip takes us out of the (block) - ;; comment; insert the fill prefix at bol - ;; instead and keep the position. - (setq pos (copy-marker pos t)) - (beginning-of-line) - (insert-and-inherit (car fill)) - (if soft (insert-and-inherit ?\n) (newline 1)) - (goto-char pos) - (set-marker pos nil)) - ;; Don't break in the middle of a comment starter - ;; or ender. - (cond ((> (point) comment-text-end) - (goto-char comment-text-end)) - ((< (point) (+ (car c-lit-limits) 2)) - (goto-char (+ (car c-lit-limits) 2)))) - (funcall do-line-break) - (insert-and-inherit (car fill)) - (if (and (looking-at c-block-comment-ender-regexp) - (memq (char-before) '(?\ ?\t))) - (backward-char)))) ; can this hit the - ; middle of a TAB? - ;; Inside a comment that should be broken. - (let ((comment-start comment-start) - (comment-end comment-end) - col) - (if (eq c-lit-type 'c) - (unless (string-match "[ \t]*/\\*" comment-start) - (setq comment-start "/* " comment-end " */")) - (unless (string-match "[ \t]*//" comment-start) - (setq comment-start "// " comment-end ""))) - (setq col (save-excursion - (back-to-indentation) - (current-column))) - (funcall do-line-break) - (when (and comment-end (not (equal comment-end ""))) - (forward-char -1) - (insert-and-inherit comment-end) - (forward-char 1)) - ;; c-comment-indent may look at the current - ;; indentation, so let's start out with the same - ;; indentation as the previous one. - (indent-to col) - (insert-and-inherit comment-start) - (indent-for-comment)))) - ((c-query-and-set-macro-start) - ;; In a macro. - (unless (looking-at "[ \t]*\\\\$") - ;; Do not clobber the alignment of the line continuation - ;; slash; c-backslash-region might look at it. - (delete-horizontal-space)) - ;; Got an asymmetry here: In normal code this command - ;; doesn't indent the next line syntactically, and otoh a - ;; normal syntactically indenting newline doesn't continue - ;; the macro. - (c-newline-and-indent (if allow-auto-fill nil 1))) - (t - ;; Somewhere else in the code. - (let ((col (save-excursion + (c-with-string-fences + (let ((fill-prefix fill-prefix) + (do-line-break + (lambda () + (delete-horizontal-space) + (if soft + (insert-and-inherit ?\n) + (newline (if allow-auto-fill nil 1))))) + ;; Already know the literal type and limits when called from + ;; c-context-line-break. + (c-lit-limits c-lit-limits) + (c-lit-type c-lit-type) + (c-macro-start c-macro-start)) + + (c-save-buffer-state () + (when (not (eq c-auto-fill-prefix t)) + ;; Called from do-auto-fill. + (unless c-lit-limits + (setq c-lit-limits (c-literal-limits nil nil t))) + (unless c-lit-type + (setq c-lit-type (c-literal-type c-lit-limits))) + (if (memq (cond ((c-query-and-set-macro-start) 'cpp) + ((null c-lit-type) 'code) + (t c-lit-type)) + c-ignore-auto-fill) + (setq fill-prefix t) ; Used as flag in the cond. + (if (and (null c-auto-fill-prefix) + (eq c-lit-type 'c) + (<= (c-point 'bol) (car c-lit-limits))) + ;; The adaptive fill function has generated a prefix, but + ;; we're on the first line in a block comment so it'll be + ;; wrong. Ignore it to guess a better one below. + (setq fill-prefix nil) + (when (and (eq c-lit-type 'c++) + (not (string-match (concat "\\`[ \t]*" + c-line-comment-starter) + (or fill-prefix "")))) + ;; Kludge: If the function that adapted the fill prefix + ;; doesn't produce the required comment starter for line + ;; comments, then we ignore it. + (setq fill-prefix nil))) + ))) + + (cond ((eq fill-prefix t) + ;; A call from do-auto-fill which should be ignored. + ) + (fill-prefix + ;; A fill-prefix overrides anything. + (funcall do-line-break) + (insert-and-inherit fill-prefix)) + ((c-save-buffer-state () + (unless c-lit-limits + (setq c-lit-limits (c-literal-limits))) + (unless c-lit-type + (setq c-lit-type (c-literal-type c-lit-limits))) + (memq c-lit-type '(c c++))) + ;; Some sort of comment. + (if (or comment-multi-line + (save-excursion + (goto-char (car c-lit-limits)) + (end-of-line) + (< (point) (cdr c-lit-limits)))) + ;; Inside a comment that should be continued. + (let ((fill (c-save-buffer-state nil + (c-guess-fill-prefix + (setq c-lit-limits + (c-collect-line-comments c-lit-limits)) + c-lit-type))) + (pos (point)) + (comment-text-end + (or (and (eq c-lit-type 'c) + (save-excursion + (goto-char (- (cdr c-lit-limits) 2)) + (if (looking-at "\\*/") (point)))) + (cdr c-lit-limits)))) + ;; Skip forward past the fill prefix in case + ;; we're standing in it. + ;; + ;; FIXME: This doesn't work well in cases like + ;; + ;; /* Bla bla bla bla bla + ;; bla bla + ;; + ;; If point is on the 'B' then the line will be + ;; broken after "Bla b". + ;; + ;; If we have an empty comment, /* */, the next + ;; lot of code pushes point to the */. We fix + ;; this by never allowing point to end up to the + ;; right of where it started. + (while (and (< (current-column) (cdr fill)) + (not (eolp))) + (forward-char 1)) + (if (and (> (point) comment-text-end) + (> (c-point 'bol) (car c-lit-limits))) + (progn + ;; The skip takes us out of the (block) + ;; comment; insert the fill prefix at bol + ;; instead and keep the position. + (setq pos (copy-marker pos t)) (beginning-of-line) - (while (and (looking-at "[ \t]*\\\\?$") - (= (forward-line -1) 0))) - (current-indentation)))) - (funcall do-line-break) - (indent-to col)))))) + (insert-and-inherit (car fill)) + (if soft (insert-and-inherit ?\n) (newline 1)) + (goto-char pos) + (set-marker pos nil)) + ;; Don't break in the middle of a comment starter + ;; or ender. + (cond ((> (point) comment-text-end) + (goto-char comment-text-end)) + ((< (point) (+ (car c-lit-limits) 2)) + (goto-char (+ (car c-lit-limits) 2)))) + (funcall do-line-break) + (insert-and-inherit (car fill)) + (if (and (looking-at c-block-comment-ender-regexp) + (memq (char-before) '(?\ ?\t))) + (backward-char)))) ; can this hit the + ; middle of a TAB? + ;; Inside a comment that should be broken. + (let ((comment-start comment-start) + (comment-end comment-end) + col) + (if (eq c-lit-type 'c) + (unless (string-match "[ \t]*/\\*" comment-start) + (setq comment-start "/* " comment-end " */")) + (unless (string-match "[ \t]*//" comment-start) + (setq comment-start "// " comment-end ""))) + (setq col (save-excursion + (back-to-indentation) + (current-column))) + (funcall do-line-break) + (when (and comment-end (not (equal comment-end ""))) + (forward-char -1) + (insert-and-inherit comment-end) + (forward-char 1)) + ;; c-comment-indent may look at the current + ;; indentation, so let's start out with the same + ;; indentation as the previous one. + (indent-to col) + (insert-and-inherit comment-start) + (indent-for-comment)))) + ((c-query-and-set-macro-start) + ;; In a macro. + (unless (looking-at "[ \t]*\\\\$") + ;; Do not clobber the alignment of the line continuation + ;; slash; c-backslash-region might look at it. + (delete-horizontal-space)) + ;; Got an asymmetry here: In normal code this command + ;; doesn't indent the next line syntactically, and otoh a + ;; normal syntactically indenting newline doesn't continue + ;; the macro. + (c-newline-and-indent (if allow-auto-fill nil 1))) + (t + ;; Somewhere else in the code. + (let ((col (save-excursion + (beginning-of-line) + (while (and (looking-at "[ \t]*\\\\?$") + (= (forward-line -1) 0))) + (current-indentation)))) + (funcall do-line-break) + (indent-to col))))))) (defalias 'c-comment-line-break-function 'c-indent-new-comment-line) (make-obsolete 'c-comment-line-break-function 'c-indent-new-comment-line "21.1") -;; Advice for Emacsen older than 21.1 (!), released 2001/10 -(unless (boundp 'comment-line-break-function) - (defvar c-inside-line-break-advice nil) - (defadvice indent-new-comment-line (around c-line-break-advice - activate preactivate) - "Call `c-indent-new-comment-line' if in CC Mode." - (if (or c-inside-line-break-advice - (not c-buffer-is-cc-mode)) - ad-do-it - (let ((c-inside-line-break-advice t)) - (c-indent-new-comment-line (ad-get-arg 0)))))) - (defun c-context-line-break () "Do a line break suitable to the context. @@ -5060,58 +5077,59 @@ When point is inside a string, only insert a backslash when it is also inside a preprocessor directive." (interactive "*") - (let* (c-lit-limits c-lit-type - (c-macro-start c-macro-start) - case-fold-search) - - (c-save-buffer-state () - (setq c-lit-limits (c-literal-limits nil nil t) - c-lit-type (c-literal-type c-lit-limits)) - (when (eq c-lit-type 'c++) - (setq c-lit-limits (c-collect-line-comments c-lit-limits))) - (c-query-and-set-macro-start)) - - (cond - ((or (eq c-lit-type 'c) - (and (eq c-lit-type 'c++) ; C++ comment, but not at the very end of it. - (< (save-excursion - (skip-chars-forward " \t") - (point)) - (1- (cdr c-lit-limits)))) - (and (numberp c-macro-start) ; Macro, but not at the very end of + (c-with-string-fences + (let* (c-lit-limits c-lit-type + (c-macro-start c-macro-start) + case-fold-search) + + (c-save-buffer-state () + (setq c-lit-limits (c-literal-limits nil nil t) + c-lit-type (c-literal-type c-lit-limits)) + (when (eq c-lit-type 'c++) + (setq c-lit-limits (c-collect-line-comments c-lit-limits))) + (c-query-and-set-macro-start)) + + (cond + ((or (eq c-lit-type 'c) + (and (eq c-lit-type 'c++) ; C++ comment, but not at the very end of it. + (< (save-excursion + (skip-chars-forward " \t") + (point)) + (1- (cdr c-lit-limits)))) + (and (numberp c-macro-start) ; Macro, but not at the very end of ; it, not in a string, and not in the ; cpp keyword. - (not (eq c-lit-type 'string)) - (or (not (looking-at "\\s *$")) - (eq (char-before) ?\\)) - (<= (save-excursion - (goto-char c-macro-start) - (if (looking-at c-opt-cpp-start) - (goto-char (match-end 0))) - (point)) - (point)))) - (let ((comment-multi-line t) - (fill-prefix nil)) - (c-indent-new-comment-line nil t))) - - ((eq c-lit-type 'string) - (if (and (numberp c-macro-start) - (not (eq (char-before) ?\\))) - (insert ?\\)) - (newline)) - - (t (delete-horizontal-space) - (newline) - ;; c-indent-line may look at the current indentation, so let's - ;; start out with the same indentation as the previous line. - (let ((col (save-excursion - (backward-char) - (forward-line 0) - (while (and (looking-at "[ \t]*\\\\?$") - (= (forward-line -1) 0))) - (current-indentation)))) - (indent-to col)) - (indent-according-to-mode))))) + (not (eq c-lit-type 'string)) + (or (not (looking-at "\\s *$")) + (eq (char-before) ?\\)) + (<= (save-excursion + (goto-char c-macro-start) + (if (looking-at c-opt-cpp-start) + (goto-char (match-end 0))) + (point)) + (point)))) + (let ((comment-multi-line t) + (fill-prefix nil)) + (c-indent-new-comment-line nil t))) + + ((eq c-lit-type 'string) + (if (and (numberp c-macro-start) + (not (eq (char-before) ?\\))) + (insert ?\\)) + (newline)) + + (t (delete-horizontal-space) + (newline) + ;; c-indent-line may look at the current indentation, so let's + ;; start out with the same indentation as the previous line. + (let ((col (save-excursion + (backward-char) + (forward-line 0) + (while (and (looking-at "[ \t]*\\\\?$") + (= (forward-line -1) 0))) + (current-indentation)))) + (indent-to col)) + (indent-according-to-mode)))))) (defun c-context-open-line () "Insert a line break suitable to the context and leave point before it. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index a1270243550..9edaf465346 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1563,6 +1563,28 @@ with value CHAR in the region [FROM to)." (forward-char))))) +;; Miscellaneous macro(s) +(defvar c-string-fences-set-flag nil) +;; Non-nil when we have set string fences with `c-restore-string-fences'. +(defmacro c-with-string-fences (&rest forms) + ;; Restore the string fences, evaluate FORMS, then remove them again. It + ;; should only be used at the top level of "boundary" functions in CC Mode, + ;; i.e. those called from outside CC Mode which directly or indirectly need + ;; unbalanced string markers to have their string-fence syntax-table text + ;; properties. This includes all calls to `c-parse-state'. This macro will + ;; be invoked recursively; however the `c-string-fences-set-flag' mechanism + ;; should ensure consistency, when this happens. + (declare (debug t)) + `(unwind-protect + (progn + (unless c-string-fences-set-flag + (c-restore-string-fences)) + (let ((c-string-fences-set-flag t)) + ,@forms)) + (unless c-string-fences-set-flag + (c-clear-string-fences)))) + + ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. ;; For our purposes, these are characterized by being possible to ;; remove again without affecting the other text properties in the diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ebc1ef43010..cfbb668baeb 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1239,7 +1239,7 @@ comment at the start of cc-engine.el for more info." (not comma-delimited) (not (c-looking-at-inexpr-block lim nil t)) (save-excursion - (c-backward-token-2 1 t nil) + (c-backward-token-2 1 t nil) ; Don't test the value (not (looking-at "=\\([^=]\\|$\\)"))) (or (not c-opt-block-decls-with-vars-key) @@ -3422,7 +3422,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ;; Return a good pos (in the sense of `c-state-cache-good-pos') at the ;; lowest[*] position between POS and HERE which is syntactically equivalent ;; to HERE. This position may be HERE itself. POS is before HERE in the - ;; buffer. + ;; buffer. If POS and HERE are both in the same literal, return the start + ;; of the literal. STATE is the parsing state at POS. + ;; ;; [*] We don't actually always determine this exact position, since this ;; would require a disproportionate amount of work, given that this function ;; deals only with a corner condition, and POS and HERE are typically on @@ -3438,7 +3440,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (setq pos (point) state s))) (if (eq (point) here) ; HERE is in the same literal as POS - pos + (nth 8 state) ; A valid good pos cannot be in a literal. (setq s (parse-partial-sexp pos here (1+ (car state)) nil state nil)) (cond ((> (car s) (car state)) ; Moved into a paren between POS and HERE @@ -3884,7 +3886,10 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (cons (if (and ce (< bra ce) (> ce here)) ; {..} straddling HERE? bra (point-min)) - (min here from))))))))) + (progn + (goto-char (min here from)) + (c-beginning-of-macro) + (point)))))))))) (defsubst c-state-push-any-brace-pair (bra+1 macro-start-or-here) ;; If BRA+1 is nil, do nothing. Otherwise, BRA+1 is the buffer position @@ -6139,7 +6144,7 @@ comment at the start of cc-engine.el for more info." (setq s (cons -1 (cdr s)))) ((and (equal match ",") (eq (car s) -1))) ; at "," in "class foo : bar, ..." - ((member match '(";" "*" "," "(")) + ((member match '(";" "*" "," ")")) (when (and s (cdr s) (<= (car s) 0)) (setq s (cdr s)))) ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds) @@ -6832,7 +6837,7 @@ comment at the start of cc-engine.el for more info." (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) (puthash type t c-found-types) - (when (and (not c-record-found-types) ; Only call `c-fontify-new-fount-type' + (when (and (not c-record-found-types) ; Only call `c-fontify-new-found-type' ; when we haven't "bound" c-found-types ; to itself in c-forward-<>-arglist. (eq (string-match c-symbol-key type) 0) @@ -6846,7 +6851,7 @@ comment at the start of cc-engine.el for more info." ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid ;; adding all prefixes of a type as it's being entered and font locked. ;; This is a bit rough and ready, but now covers adding characters into the - ;; middle of an identifer. + ;; middle of an identifier. ;; ;; This function might do hidden buffer changes. (if (and c-new-id-start c-new-id-end @@ -8284,9 +8289,10 @@ multi-line strings (but not C++, for example)." (defun c-forward-noise-clause () ;; Point is at a c-noise-macro-with-parens-names macro identifier. Go ;; forward over this name, any parenthesis expression which follows it, and - ;; any syntactic WS, ending up at the next token. If there is an unbalanced - ;; paren expression, leave point at it. Always Return t. - (c-forward-token-2) + ;; any syntactic WS, ending up at the next token or EOB. If there is an + ;; unbalanced paren expression, leave point at it. Always Return t. + (or (zerop (c-forward-token-2)) + (goto-char (point-max))) (if (and (eq (char-after) ?\() (c-go-list-forward)) (c-forward-syntactic-ws)) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 230d39efeeb..625010b04b2 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1820,7 +1820,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; Fontification". - (let (mode capture-default id-start id-end declaration sub-begin sub-end) + (let (mode capture-default id-start id-end declaration sub-begin sub-end tem) (while (and (< (point) limit) (search-forward "[" limit t)) (when (progn (backward-char) @@ -1832,15 +1832,18 @@ casts and declarations are fontified. Used on level 2 and higher." (char-after))) ;; Is the first element of the list a bare "=" or "&"? (when mode - (forward-char) - (c-forward-syntactic-ws) - (if (memq (char-after) '(?, ?\])) - (progn - (setq capture-default mode) - (when (eq (char-after) ?,) - (forward-char) - (c-forward-syntactic-ws))) - (c-backward-token-2))) + (setq tem nil) + (save-excursion + (forward-char) + (c-forward-syntactic-ws) + (if (memq (char-after) '(?, ?\])) + (progn + (setq capture-default mode) + (when (eq (char-after) ?,) + (forward-char) + (c-forward-syntactic-ws)) + (setq tem (point))))) + (if tem (goto-char tem))) ;; Go round the following loop once per captured item. We use "\\s)" ;; rather than "\\]" here to avoid infinite looping in this situation: @@ -2253,12 +2256,13 @@ higher." ;; redisplay. (defvar c-re-redisplay-timer nil) -(defun c-force-redisplay (start end) +(defun c-force-redisplay (buffer start end) ;; Force redisplay immediately. This assumes `font-lock-support-mode' is ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. - (save-excursion (c-font-lock-fontify-region start end)) - (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) - (setq c-re-redisplay-timer nil)) + (with-current-buffer buffer + (save-excursion (c-font-lock-fontify-region start end)) + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil))) (defun c-fontify-new-found-type (type) ;; Cause the fontification of TYPE, a string, wherever it occurs in the @@ -2288,6 +2292,7 @@ higher." (not c-re-redisplay-timer)) (setq c-re-redisplay-timer (run-with-timer 0 nil #'c-force-redisplay + (current-buffer) (match-beginning 0) (match-end 0))))))))))) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index ea5dd48986c..584db86539e 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -76,6 +76,8 @@ (cc-require 'cc-engine) (cc-require 'cc-styles) +(cc-bytecomp-defun c-restore-string-fences) +(cc-bytecomp-defun c-clear-string-fences) (defcustom c-guess-offset-threshold 10 @@ -225,11 +227,12 @@ guess is made from scratch. Note that the larger the region to guess in, the slower the guessing. So you can limit the region with `c-guess-region-max'." (interactive "r\nP") - (let ((accumulator (when accumulate c-guess-accumulator))) - (setq c-guess-accumulator (c-guess-examine start end accumulator)) - (let ((pair (c-guess-guess c-guess-accumulator))) - (setq c-guess-guessed-basic-offset (car pair) - c-guess-guessed-offsets-alist (cdr pair))))) + (c-with-string-fences + (let ((accumulator (when accumulate c-guess-accumulator))) + (setq c-guess-accumulator (c-guess-examine start end accumulator)) + (let ((pair (c-guess-guess c-guess-accumulator))) + (setq c-guess-guessed-basic-offset (car pair) + c-guess-guessed-offsets-alist (cdr pair)))))) (defun c-guess-examine (start end accumulator) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 68070cd0581..c5964165c8d 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -458,12 +458,14 @@ so that all identifiers are recognized as words.") c-before-change-check-<>-operators c-truncate-bs-cache c-before-change-check-unbalanced-strings - c-parse-quotes-before-change) + c-parse-quotes-before-change + c-before-change-fix-comment-escapes) (c objc) '(c-extend-region-for-CPP c-depropertize-CPP c-truncate-bs-cache c-before-change-check-unbalanced-strings - c-parse-quotes-before-change) + c-parse-quotes-before-change + c-before-change-fix-comment-escapes) java '(c-parse-quotes-before-change c-before-change-check-unbalanced-strings c-before-change-check-<>-operators) @@ -500,6 +502,7 @@ parameters \(point-min) and \(point-max).") c-after-change-mark-abnormal-strings c-change-expand-fl-region) (c objc) '(c-depropertize-new-text + c-after-change-fix-comment-escapes c-after-change-escape-NL-in-string c-parse-quotes-after-change c-after-change-mark-abnormal-strings @@ -507,6 +510,7 @@ parameters \(point-min) and \(point-max).") c-neutralize-syntax-in-CPP c-change-expand-fl-region) c++ '(c-depropertize-new-text + c-after-change-fix-comment-escapes c-after-change-escape-NL-in-string c-after-change-unmark-ml-strings c-parse-quotes-after-change diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 3a3413dc36a..70fc1cb73a9 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -798,43 +798,44 @@ MODE is the symbol for the mode to initialize, like `c-mode'. See `c-basic-common-init' for details. It's only optional to be compatible with old code; callers should always specify it." - (unless mode - ;; Called from an old third party package. The fallback is to - ;; initialize for C. - (c-init-language-vars-for 'c-mode)) - - (c-basic-common-init mode c-default-style) - (when mode - ;; Only initialize font locking if we aren't called from an old package. - (c-font-lock-init)) - - ;; Starting a mode is a sort of "change". So call the change functions... - (save-restriction - (widen) - (setq c-new-BEG (point-min)) - (setq c-new-END (point-max)) - (save-excursion - (let (before-change-functions after-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max))) - c-get-state-before-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max) - (- (point-max) (point-min)))) - c-before-font-lock-functions)))) - - (set (make-local-variable 'outline-regexp) "[^#\n\^M]") - (set (make-local-variable 'outline-level) 'c-outline-level) - (set (make-local-variable 'add-log-current-defun-function) - (lambda () - (or (c-cpp-define-name) (car (c-defun-name-and-limits nil))))) - (let ((rfn (assq mode c-require-final-newline))) - (when rfn - (if (boundp 'mode-require-final-newline) - (and (cdr rfn) - (set (make-local-variable 'require-final-newline) - mode-require-final-newline)) - (set (make-local-variable 'require-final-newline) (cdr rfn)))))) + (let (case-fold-search) + (unless mode + ;; Called from an old third party package. The fallback is to + ;; initialize for C. + (c-init-language-vars-for 'c-mode)) + + (c-basic-common-init mode c-default-style) + (when mode + ;; Only initialize font locking if we aren't called from an old package. + (c-font-lock-init)) + + ;; Starting a mode is a sort of "change". So call the change functions... + (save-restriction + (widen) + (setq c-new-BEG (point-min)) + (setq c-new-END (point-max)) + (save-excursion + (let (before-change-functions after-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max))) + c-get-state-before-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max) + (- (point-max) (point-min)))) + c-before-font-lock-functions)))) + + (set (make-local-variable 'outline-regexp) "[^#\n\^M]") + (set (make-local-variable 'outline-level) 'c-outline-level) + (set (make-local-variable 'add-log-current-defun-function) + (lambda () + (or (c-cpp-define-name) (car (c-defun-name-and-limits nil))))) + (let ((rfn (assq mode c-require-final-newline))) + (when rfn + (if (boundp 'mode-require-final-newline) + (and (cdr rfn) + (set (make-local-variable 'require-final-newline) + mode-require-final-newline)) + (set (make-local-variable 'require-final-newline) (cdr rfn))))))) (defun c-count-cfss (lv-alist) ;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many @@ -996,7 +997,8 @@ Note that the style variables are always made local to the buffer." ;; `c-before/after-change', frame 3 is the primitive invoking the change ;; hook. (memq (cadr (backtrace-frame 3)) - '(put-text-property remove-list-of-text-properties))) + '(put-text-property remove-text-properties + remove-list-of-text-properties))) (defun c-depropertize-CPP (beg end) ;; Remove the punctuation syntax-table text property from the CPP parts of @@ -1318,7 +1320,8 @@ Note that the style variables are always made local to the buffer." ;; balanced by another " is left with a '(1) syntax-table property. (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr) - (let (s pos) + (c-save-buffer-state (s pos) ; Prevent text property stuff causing change + ; function invocation. (setq pos c-min-syn-tab-mkr) (while (and @@ -1341,7 +1344,8 @@ Note that the style variables are always made local to the buffer." (c-search-backward-char-property-with-value-on-char 'c-fl-syn-tab '(15) ?\" (max (- (point) 500) (point-min)))) - (not (equal (c-get-char-property (point) 'syntax-table) '(1)))) + (not (equal (c-get-char-property (point) 'syntax-table) + '(1)))) (setq pos (1+ pos)))) (while (< pos c-max-syn-tab-mkr) (setq pos @@ -1371,7 +1375,9 @@ Note that the style variables are always made local to the buffer." ;; Restore any syntax-table text properties which are "mirrored" by ;; c-fl-syn-tab text properties. (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr) - (let ((pos c-min-syn-tab-mkr)) + (c-save-buffer-state ; Prevent text property stuff causing change function + ; invocation. + ((pos c-min-syn-tab-mkr)) (while (and (< pos c-max-syn-tab-mkr) @@ -1973,6 +1979,87 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (defvar c-new-id-is-type nil) (make-variable-buffer-local 'c-new-id-is-type) +(defun c-before-change-fix-comment-escapes (beg end) + "Remove punctuation syntax-table text properties from C/C++ comment markers. +This is to handle the rare case of two or more backslashes at an +end of line in a // comment or the equally rare case of a +backslash preceding the terminator of a /* comment, as \\*/. + +This function is used solely as a member of +`c-get-state-before-change-functions', where it should appear +late in that variable, and it must be used only together with +`c-after-change-fix-comment-escapes'. + +Note that the function currently only handles comments beginning +with // and /*, not more generic line and block comments." + (c-save-buffer-state (end-state) + (setq end-state (c-full-pp-to-literal end)) + (when (memq (cadr end-state) '(c c++)) + (goto-char (max (- beg 2) (point-min))) + (if (eq (cadr end-state) 'c) + (when (search-forward "\\*/" + (or (cdr (caddr end-state)) (point-max)) t) + (c-clear-char-property (match-beginning 0) 'syntax-table) + (c-truncate-lit-pos-cache (match-beginning 0))) + (while (search-forward "\\\\\n" + (or (cdr (caddr end-state)) (point-max)) t) + (c-clear-char-property (match-beginning 0) 'syntax-table) + (c-truncate-lit-pos-cache (match-beginning 0))))))) + +(defun c-after-change-fix-comment-escapes (beg end _old-len) + "Apply punctuation syntax-table text properties to C/C++ comment markers. +This is to handle the rare case of two or more backslashes at an +end of line in a // comment or the equally rare case of a +backslash preceding the terminator of a /* comment, as \\*/. + +This function is used solely as a member of +`c-before-font-lock-functions', where it should appear early in +that variable, and it must be used only together with +`c-before-change-fix-comment-escapes'. + +Note that the function currently only handles comments beginning +with // and /*, not more generic line and block comments." + (c-save-buffer-state (state) + ;; We cannot use `c-full-pp-to-literal' in this function, since the + ;; `syntax-table' text properties after point are not yet in a consistent + ;; state. + (setq state (c-semi-pp-to-literal beg)) + (goto-char (if (memq (cadr state) '(c c++)) + (caddr state) + (max (- beg 2) (point-min)))) + (while + (re-search-forward "\\\\\\(\\(\\\\\n\\)\\|\\(\\*/\\)\\)" + (min (+ end 2) (point-max)) t) + (setq state (c-semi-pp-to-literal (match-beginning 0))) + (when (cond + ((eq (cadr state) 'c) + (match-beginning 3)) + ((eq (cadr state) 'c++) + (match-beginning 2))) + (c-put-char-property (match-beginning 0) 'syntax-table '(1)) + (c-truncate-lit-pos-cache (match-beginning 0)))) + + (goto-char end) + (setq state (c-semi-pp-to-literal (point))) + (cond + ((eq (cadr state) 'c) + (when (search-forward "*/" nil t) + (when (eq (char-before (match-beginning 0)) ?\\) + (c-put-char-property (1- (match-beginning 0)) 'syntax-table '(1)) + (c-truncate-lit-pos-cache (1- (match-beginning 0)))))) + ((eq (cadr state) 'c++) + (while + (progn + (end-of-line) + (and (eq (char-before) ?\\) + (progn + (when (eq (char-before (1- (point))) ?\\) + (c-put-char-property (- (point) 2) 'syntax-table '(1)) + (c-truncate-lit-pos-cache (1- (point)))) + t) + (not (eobp)))) + (forward-char)))))) + (defun c-update-new-id (end) ;; Note the bounds of any identifier that END is in or just after, in ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to @@ -1984,7 +2071,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c-new-id-end (and id-beg (progn (c-end-of-current-token) (point))))))) - (defun c-post-command () ;; If point was inside of a new identifier and no longer is, record that ;; fact. @@ -2015,120 +2101,116 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; or a comment - "wrongly" removing a symbol from `c-found-types' ;; isn't critical. (unless (c-called-from-text-property-change-p) - (save-restriction - (widen) - ;; Clear the list of found types if we make a change at the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (eq beg (point-min)) - (c-clear-found-types)) - (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' - ;; without an intervening `after-change-functions'. An example of - ;; this is bug #38691. To protect CC Mode, assume that the entire - ;; buffer has changed. - (setq beg (point-min) - end (point-max) - c-just-done-before-change 'whole-buffer) - (setq c-just-done-before-change t)) - ;; (c-new-BEG c-new-END) will be the region to fontify. - (setq c-new-BEG beg c-new-END end) - (setq c-maybe-stale-found-type nil) - ;; A workaround for syntax-ppss's failure to notice syntax-table text - ;; property changes. - (when (fboundp 'syntax-ppss) - (setq c-syntax-table-hwm most-positive-fixnum)) - (save-match-data - (widen) - (unwind-protect - (progn - (c-restore-string-fences) - (save-excursion - ;; Are we inserting/deleting stuff in the middle of an - ;; identifier? - (c-unfind-enclosing-token beg) - (c-unfind-enclosing-token end) - ;; 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 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;"? - ;; - ;; We search for appropriate c-type properties "near" - ;; the change. First, find an appropriate boundary - ;; for this property search. - (let (lim lim-2 - type type-pos - marked-id term-pos - (end1 - (or (and (eq (get-text-property end 'face) - 'font-lock-comment-face) - (previous-single-property-change end 'face)) - end))) - (when (>= end1 beg) ; Don't hassle about changes entirely in + (c-with-string-fences + (save-restriction + (widen) + ;; Clear the list of found types if we make a change at the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (eq beg (point-min)) + (c-clear-found-types)) + (if c-just-done-before-change + ;; We have two consecutive calls to `before-change-functions' + ;; without an intervening `after-change-functions'. An example of + ;; this is bug #38691. To protect CC Mode, assume that the entire + ;; buffer has changed. + (setq beg (point-min) + end (point-max) + c-just-done-before-change 'whole-buffer) + (setq c-just-done-before-change t)) + ;; (c-new-BEG c-new-END) will be the region to fontify. + (setq c-new-BEG beg c-new-END end) + (setq c-maybe-stale-found-type nil) + ;; A workaround for syntax-ppss's failure to notice syntax-table text + ;; property changes. + (when (fboundp 'syntax-ppss) + (setq c-syntax-table-hwm most-positive-fixnum)) + (save-match-data + (save-excursion + ;; Are we inserting/deleting stuff in the middle of an + ;; identifier? + (c-unfind-enclosing-token beg) + (c-unfind-enclosing-token end) + ;; 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 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;"? + ;; + ;; We search for appropriate c-type properties "near" + ;; the change. First, find an appropriate boundary + ;; for this property search. + (let (lim lim-2 + type type-pos + marked-id term-pos + (end1 + (or (and (eq (get-text-property end 'face) + 'font-lock-comment-face) + (previous-single-property-change end 'face)) + end))) + (when (>= end1 beg) ; Don't hassle about changes entirely in ; comments. - ;; Find a limit for the search for a `c-type' property - ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06). - (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06) - )) - (while - (and (/= (skip-chars-backward "^;{}" lim-2) 0) - (> (point) (point-min)) - (memq (c-get-char-property (1- (point)) 'face) - '(font-lock-comment-face font-lock-string-face)))) - (setq lim (max (point-min) (1- (point)))) - - ;; Look for the latest `c-type' property before end1 - (when (and (> end1 (point-min)) - (setq type-pos - (if (get-text-property (1- end1) 'c-type) - end1 - (previous-single-property-change end1 'c-type - nil lim)))) - (setq type (get-text-property (max (1- type-pos) lim) 'c-type)) - - (when (memq type '(c-decl-id-start c-decl-type-start)) - ;; Get the identifier, if any, that the property is on. - (goto-char (1- type-pos)) - (setq marked-id - (when (looking-at "\\(\\sw\\|\\s_\\)") - (c-beginning-of-current-token) - (buffer-substring-no-properties (point) type-pos))) - - (goto-char end1) - (setq lim-2 (c-determine-+ve-limit 1000)) - (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for + ;; Find a limit for the search for a `c-type' property + ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06). + (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06) + )) + (while + (and (/= (skip-chars-backward "^;{}" lim-2) 0) + (> (point) (point-min)) + (memq (c-get-char-property (1- (point)) 'face) + '(font-lock-comment-face font-lock-string-face)))) + (setq lim (max (point-min) (1- (point)))) + + ;; Look for the latest `c-type' property before end1 + (when (and (> end1 (point-min)) + (setq type-pos + (if (get-text-property (1- end1) 'c-type) + end1 + (previous-single-property-change end1 'c-type + nil lim)))) + (setq type (get-text-property (max (1- type-pos) lim) 'c-type)) + + (when (memq type '(c-decl-id-start c-decl-type-start)) + ;; Get the identifier, if any, that the property is on. + (goto-char (1- type-pos)) + (setq marked-id + (when (looking-at "\\(\\sw\\|\\s_\\)") + (c-beginning-of-current-token) + (buffer-substring-no-properties (point) type-pos))) + + (goto-char end1) + (setq lim-2 (c-determine-+ve-limit 1000)) + (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for ; comment, maybe - (setq lim (point)) - (setq term-pos - (or (c-next-single-property-change end 'c-type nil lim) lim)) - (setq c-maybe-stale-found-type - (list type marked-id - type-pos term-pos - (buffer-substring-no-properties type-pos - term-pos) - (buffer-substring-no-properties beg end))))))) - - (if c-get-state-before-change-functions - (mapc (lambda (fn) - (funcall fn beg end)) - c-get-state-before-change-functions)) - - (c-laomib-invalidate-cache beg end))) - (c-clear-string-fences)))) - (c-truncate-lit-pos-cache beg) - ;; The following must be done here rather than in `c-after-change' - ;; because newly inserted parens would foul up the invalidation - ;; algorithm. - (c-invalidate-state-cache beg) - ;; The following must happen after the previous, which likely alters - ;; the macro cache. - (when c-opt-cpp-symbol - (c-invalidate-macro-cache beg end)))) + (setq lim (point)) + (setq term-pos + (or (c-next-single-property-change end 'c-type nil lim) lim)) + (setq c-maybe-stale-found-type + (list type marked-id + type-pos term-pos + (buffer-substring-no-properties type-pos + term-pos) + (buffer-substring-no-properties beg end))))))) + + (if c-get-state-before-change-functions + (mapc (lambda (fn) + (funcall fn beg end)) + c-get-state-before-change-functions)) + + (c-laomib-invalidate-cache beg end)))) + (c-truncate-lit-pos-cache beg) + ;; The following must be done here rather than in `c-after-change' + ;; because newly inserted parens would foul up the invalidation + ;; algorithm. + (c-invalidate-state-cache beg) + ;; The following must happen after the previous, which likely alters + ;; the macro cache. + (when c-opt-cpp-symbol + (c-invalidate-macro-cache beg end))))) (defvar c-in-after-change-fontification nil) (make-variable-buffer-local 'c-in-after-change-fontification) @@ -2180,51 +2262,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (save-restriction (save-match-data ; c-recognize-<>-arglists changes match-data (widen) - (unwind-protect - (progn - (c-restore-string-fences) - (when (> end (point-max)) - ;; Some emacsen might return positions past the end. This - ;; has been observed in Emacs 20.7 when rereading a buffer - ;; changed on disk (haven't been able to minimize it, but - ;; Emacs 21.3 appears to work). - (setq end (point-max)) - (when (> beg end) - (setq beg end))) - - ;; C-y is capable of spuriously converting category - ;; properties c-</>-as-paren-syntax and - ;; c-cpp-delimiter into hard syntax-table properties. - ;; Remove these when it happens. - (when (eval-when-compile (memq 'category-properties c-emacs-features)) - (c-save-buffer-state () - (c-clear-char-property-with-value beg end 'syntax-table - c-<-as-paren-syntax) - (c-clear-char-property-with-value beg end 'syntax-table - c->-as-paren-syntax) - (c-clear-char-property-with-value beg end 'syntax-table nil))) - - (c-update-new-id end) - (c-trim-found-types beg end old-len) ; maybe we don't - ; need all of these. - (c-invalidate-sws-region-after beg end old-len) - ;; (c-invalidate-state-cache beg) ; moved to - ;; `c-before-change'. - (c-invalidate-find-decl-cache beg) - - (when c-recognize-<>-arglists - (c-after-change-check-<>-operators beg end)) - - (setq c-in-after-change-fontification t) - (save-excursion - (mapc (lambda (fn) - (funcall fn beg end old-len)) - c-before-font-lock-functions))) - (c-clear-string-fences)))))) + (c-with-string-fences + (when (> end (point-max)) + ;; Some emacsen might return positions past the end. This + ;; has been observed in Emacs 20.7 when rereading a buffer + ;; changed on disk (haven't been able to minimize it, but + ;; Emacs 21.3 appears to work). + (setq end (point-max)) + (when (> beg end) + (setq beg end))) + + ;; C-y is capable of spuriously converting category + ;; properties c-</>-as-paren-syntax and + ;; c-cpp-delimiter into hard syntax-table properties. + ;; Remove these when it happens. + (when (eval-when-compile (memq 'category-properties c-emacs-features)) + (c-save-buffer-state () + (c-clear-char-property-with-value beg end 'syntax-table + c-<-as-paren-syntax) + (c-clear-char-property-with-value beg end 'syntax-table + c->-as-paren-syntax) + (c-clear-char-property-with-value beg end 'syntax-table nil))) + + (c-update-new-id end) + (c-trim-found-types beg end old-len) ; maybe we don't + ; need all of these. + (c-invalidate-sws-region-after beg end old-len) + ;; (c-invalidate-state-cache beg) ; moved to + ;; `c-before-change'. + (c-invalidate-find-decl-cache beg) + + (when c-recognize-<>-arglists + (c-after-change-check-<>-operators beg end)) + + (setq c-in-after-change-fontification t) + (save-excursion + (mapc (lambda (fn) + (funcall fn beg end old-len)) + c-before-font-lock-functions))))) ;; A workaround for syntax-ppss's failure to notice syntax-table text ;; property changes. - (when (fboundp 'syntax-ppss) - (syntax-ppss-flush-cache c-syntax-table-hwm))) + (when (fboundp 'syntax-ppss) + (syntax-ppss-flush-cache c-syntax-table-hwm))))) (defun c-doc-fl-decl-start (pos) ;; If the line containing POS is in a doc comment continued line (as defined @@ -2456,46 +2535,42 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (widen) (let (new-beg new-end new-region case-fold-search) (c-save-buffer-state nil - ;; Temporarily reapply the string fence syntax-table properties. - (unwind-protect - (progn - (c-restore-string-fences) - (if (and c-in-after-change-fontification - (< beg c-new-END) (> end c-new-BEG)) - ;; Region and the latest after-change fontification region overlap. - ;; Determine the upper and lower bounds of our adjusted region - ;; separately. - (progn - (if (<= beg c-new-BEG) - (setq c-in-after-change-fontification nil)) - (setq new-beg - (if (and (>= beg (c-point 'bol c-new-BEG)) - (<= beg c-new-BEG)) - ;; Either jit-lock has accepted `c-new-BEG', or has - ;; (probably) extended the change region spuriously - ;; to BOL, which position likely has a - ;; syntactically different position. To ensure - ;; correct fontification, we start at `c-new-BEG', - ;; assuming any characters to the left of - ;; `c-new-BEG' on the line do not require - ;; fontification. - c-new-BEG - (setq new-region (c-before-context-fl-expand-region beg end) - new-end (cdr new-region)) - (car new-region))) - (setq new-end - (if (and (>= end (c-point 'bol c-new-END)) - (<= end c-new-END)) - c-new-END - (or new-end - (cdr (c-before-context-fl-expand-region beg end)))))) - ;; Context (etc.) fontification. - (setq new-region (c-before-context-fl-expand-region beg end) - new-beg (car new-region) new-end (cdr new-region))) - ;; Finally invoke font lock's functionality. - (funcall (default-value 'font-lock-fontify-region-function) - new-beg new-end verbose)) - (c-clear-string-fences)))))) + (c-with-string-fences + (if (and c-in-after-change-fontification + (< beg c-new-END) (> end c-new-BEG)) + ;; Region and the latest after-change fontification region overlap. + ;; Determine the upper and lower bounds of our adjusted region + ;; separately. + (progn + (if (<= beg c-new-BEG) + (setq c-in-after-change-fontification nil)) + (setq new-beg + (if (and (>= beg (c-point 'bol c-new-BEG)) + (<= beg c-new-BEG)) + ;; Either jit-lock has accepted `c-new-BEG', or has + ;; (probably) extended the change region spuriously + ;; to BOL, which position likely has a + ;; syntactically different position. To ensure + ;; correct fontification, we start at `c-new-BEG', + ;; assuming any characters to the left of + ;; `c-new-BEG' on the line do not require + ;; fontification. + c-new-BEG + (setq new-region (c-before-context-fl-expand-region beg end) + new-end (cdr new-region)) + (car new-region))) + (setq new-end + (if (and (>= end (c-point 'bol c-new-END)) + (<= end c-new-END)) + c-new-END + (or new-end + (cdr (c-before-context-fl-expand-region beg end)))))) + ;; Context (etc.) fontification. + (setq new-region (c-before-context-fl-expand-region beg end) + new-beg (car new-region) new-end (cdr new-region))) + ;; Finally invoke font lock's functionality. + (funcall (default-value 'font-lock-fontify-region-function) + new-beg new-end verbose)))))) (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 8fe8402b1d8..1cf14d52d55 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -180,6 +180,7 @@ (inclass . +) (inline-open . 0)))) ("linux" + (indent-tabs-mode . t) (c-basic-offset . 8) (c-comment-only-line-offset . 0) (c-hanging-braces-alist . ((brace-list-open) diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 6fc898d95be..32031d19462 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -793,14 +793,6 @@ bundle agent rcfiles (cdr (assq 'functions cfengine3-fallback-syntax))) 'symbols)) -(defcustom cfengine-mode-abbrevs nil - "Abbrevs for CFEngine2 mode." - :type '(repeat (list (string :tag "Name") - (string :tag "Expansion") - (choice :tag "Hook" (const nil) function)))) - -(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1") - ;; Taken from the doc for pre-release 2.1. (eval-and-compile (defconst cfengine2-actions @@ -989,13 +981,7 @@ Intended as the value of `indent-line-function'." (defun cfengine-fill-paragraph (&optional justify) "Fill `paragraphs' in Cfengine code." (interactive "P") - (or (if (fboundp 'fill-comment-paragraph) - (fill-comment-paragraph justify) - ;; else do nothing in a comment - (nth 4 (parse-partial-sexp (save-excursion - (beginning-of-defun) - (point)) - (point)))) + (or (fill-comment-paragraph justify) (let ((paragraph-start ;; Include start of parenthesized block. "\f\\|[ \t]*$\\|.*(") @@ -1415,7 +1401,6 @@ to the action header." (setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+") (setq-local outline-level #'cfengine2-outline-level) (setq-local fill-paragraph-function #'cfengine-fill-paragraph) - (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs) (setq font-lock-defaults '(cfengine2-font-lock-keywords nil nil nil beginning-of-line)) ;; Fixme: set the args of functions in evaluated classes to string diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e75a44b6537..9f33186d8b1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -82,6 +82,25 @@ after `call-process' inserts the grep output into the buffer.") "Position of the start of the text inserted by `compilation-filter'. This is bound before running `compilation-filter-hook'.") +(defcustom compilation-hidden-output nil + "Regexp to match output from the compilation that should be hidden. +This can also be a list of regexps. + +The text matched by this variable will be made invisible, which +means that it'll still be present in the buffer, so that +navigation commands (for instance, `next-error') can still make +use of the hidden text to determine the current directory and the +like. + +For instance, to hide the verbose output from recursive +makefiles, you can say something like: + + (setq compilation-hidden-output + \\='(\"^make[^\n]+\n\"))" + :type '(choice regexp + (repeat regexp)) + :version "29.1") + (defvar compilation-first-column 1 "This is how compilers number the first column, usually 1 or 0. If this is buffer-local in the destination buffer, Emacs obeys @@ -257,7 +276,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "): ") 3 4 5 (1 . 2)) - (iar + (gradle-android + ,(rx bol (* " ") "ERROR:" + (group-n 1 ; file + (+ (not (in ":\n")))) + ":" + (group-n 2 (+ digit)) ; line + ": ") + 1 2) + + (iar "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" 1 2 nil (3)) @@ -340,66 +368,73 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1) (gnu + ;; The `gnu' message syntax is + ;; [PROGRAM:]FILE:LINE[-ENDLINE]:[COL[-ENDCOL]:] MESSAGE + ;; or + ;; [PROGRAM:]FILE:LINE[.COL][-ENDLINE[.ENDCOL]]: MESSAGE ,(rx bol - ;; Match an optional program name in the format - ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE - ;; which is used for non-interactive programs other than - ;; compilers (e.g. the "jade:" entry in compilation.txt). + ;; Match an optional program name which is used for + ;; non-interactive programs other than compilers (e.g. the + ;; "jade:" entry in compilation.txt). (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " ")) ;; Skip indentation generated by GCC's -fanalyzer. (: (+ " ") "|"))) ;; File name group. (group-n 1 - ;; Avoid matching the file name as a program in the pattern - ;; above by disallow file names entirely composed of digits. - (: (regexp "[0-9]*[^0-9\n]") - ;; This rule says that a file name can be composed - ;; of any non-newline char, but it also rules out - ;; some valid but unlikely cases, such as a - ;; trailing space or a space followed by a -, or a - ;; colon followed by a space. - (*? (| (regexp "[^\n :]") - (regexp " [^-/\n]") - (regexp ":[^ \n]"))))) - (regexp ": ?") + ;; Avoid matching the file name as a program in the pattern + ;; above by disallowing file names entirely composed of digits. + ;; Do not allow file names beginning with a space. + (| (not (in "0-9" "\n\t ")) + (: (+ (in "0-9")) + (not (in "0-9" "\n")))) + ;; A file name can be composed of any non-newline char, but + ;; rule out some valid but unlikely cases, such as a trailing + ;; space or a space followed by a -, or a colon followed by a + ;; space. + (*? (| (not (in "\n :")) + (: " " (not (in ?- "/\n"))) + (: ":" (not (in " \n")))))) + ":" (? " ") ;; Line number group. - (group-n 2 (regexp "[0-9]+")) + (group-n 2 (+ (in "0-9"))) (? (| (: "-" - (group-n 4 (regexp "[0-9]+")) ; ending line - (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column + (group-n 4 (+ (in "0-9"))) ; ending line + (? "." (group-n 5 (+ (in "0-9"))))) ; ending column (: (in ".:") - (group-n 3 (regexp "[0-9]+")) ; starting column + (group-n 3 (+ (in "0-9"))) ; starting column (? "-" - (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line - (group-n 5 (regexp "[0-9]+")))))) ; ending column + (? (group-n 4 (+ (in "0-9"))) ".") ; ending line + (group-n 5 (+ (in "0-9"))))))) ; ending column ":" (| (: (* " ") (group-n 6 (| "FutureWarning" "RuntimeWarning" - "Warning" - "warning" + "Warning" "warning" "W:"))) (: (* " ") - (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)") - "I:" - (: "[ skipping " (+ nonl) " ]") - "instantiated from" - "required from" - (regexp "[Nn]ote")))) + (group-n 7 + (| (| "Info" "info" + "Information" "information" + "Informational" "informational" + "I:" + "instantiated from" + "required from" + "Note" "note") + (: "[ skipping " (+ nonl) " ]")))) (: (* " ") - (regexp "[Ee]rror")) + (| "Error" "error")) ;; Avoid matching time stamps on the form "HH:MM:SS" where ;; MM is interpreted as a line number by trying to rule out ;; messages where the text after the line number starts with ;; a 2-digit number. - (: (regexp "[0-9]?") - (| (regexp "[^0-9\n]") + (: (? (in "0-9")) + (| (not (in "0-9\n")) eol)) - (regexp "[0-9][0-9][0-9]"))) + (: (in "0-9") (in "0-9") (in "0-9")))) 1 (2 . 4) (3 . 5) (6 . 7)) (cucumber @@ -951,7 +986,10 @@ Faces `compilation-error-face', `compilation-warning-face', (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." - :type 'boolean + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "If location known" if-location-known) + (const :tag "First known location" first-known)) :version "23.1") (defvar-local compilation-auto-jump-to-next nil @@ -1182,21 +1220,46 @@ POS and RES.") l2 (setcdr l1 (cons (list ,key) l2))))))) +(defun compilation--file-known-p () + "Say whether the file under point can be found." + (when-let* ((msg (get-text-property (point) 'compilation-message)) + (loc (compilation--message->loc msg)) + (elem (compilation-find-file-1 + (point-marker) + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc))))) + (car elem))) + (defun compilation-auto-jump (buffer pos) (when (buffer-live-p buffer) (with-current-buffer buffer (goto-char pos) (let ((win (get-buffer-window buffer 0))) (if win (set-window-point win pos))) - (if compilation-auto-jump-to-first-error - (compile-goto-error))))) + (when compilation-auto-jump-to-first-error + (cl-case compilation-auto-jump-to-first-error + ('if-location-known + (when (compilation--file-known-p) + (compile-goto-error))) + ('first-known + (let (match) + (while (and (not (compilation--file-known-p)) + (setq match (text-property-search-forward + 'compilation-message nil nil t))) + (goto-char (prop-match-beginning match)))) + (when (compilation--file-known-p) + (compile-goto-error))) + (otherwise + (compile-goto-error))))))) ;; This function is the central driver, called when font-locking to gather ;; all information needed to later jump to corresponding source code. ;; Return a property list with all meta information on this error location. (defun compilation-error-properties (file line end-line col end-col type fmt - rule) + rule) (unless (text-property-not-all (match-beginning 0) (point) 'compilation-message nil) (if file @@ -1520,7 +1583,8 @@ to `compilation-error-regexp-alist' if RULES is nil." ;; FIXME-omake: Doing it here seems wrong, at least it should depend on ;; whether or not omake's own error messages are recognized. (cond - ((not omake-included) nil) + ((or (not omake-included) (not pat)) + nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) ;; Not anchored or anchored but already allows empty spaces. (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) @@ -1539,7 +1603,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) - (while (re-search-forward pat end t) + (while (and pat (re-search-forward pat end t)) (when (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) @@ -1752,13 +1816,21 @@ If nil, ask to kill it." :type 'boolean :version "24.3") +(defcustom compilation-max-output-line-length 400 + "Output lines that are longer than this value will be hidden. +If nil, don't hide anything." + :type '(choice (const :tag "Hide nothing" nil) + integer) + :version "29.1") + (defun compilation--update-in-progress-mode-line () ;; `compilation-in-progress' affects the mode-line of all ;; buffers when it changes from nil to non-nil or vice-versa. (unless compilation-in-progress (force-mode-line-update t))) ;;;###autoload -(defun compilation-start (command &optional mode name-function highlight-regexp) +(defun compilation-start (command &optional mode name-function highlight-regexp + continue) "Run compilation command COMMAND (low level interface). If COMMAND starts with a cd command, that becomes the `default-directory'. The rest of the arguments are optional; for them, nil means use the default. @@ -1775,6 +1847,12 @@ If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight the matching section of the visited source line; the default is to use the global value of `compilation-highlight-regexp'. +If CONTINUE is non-nil, the buffer won't be emptied before +compilation is started. This can be useful if you wish to +combine the output from several compilation commands in the same +buffer. The new output will be at the end of the buffer, and +point is not changed. + Returns the compilation buffer created." (or mode (setq mode 'compilation-mode)) (let* ((name-of-mode @@ -1838,7 +1916,12 @@ Returns the compilation buffer created." (if (= (length expanded-dir) 1) (car expanded-dir) substituted-dir))))) - (erase-buffer) + (if continue + (progn + ;; Save the point so we can restore it. + (setq continue (point)) + (goto-char (point-max))) + (erase-buffer)) ;; Select the desired mode. (if (not (eq mode t)) (progn @@ -1864,12 +1947,13 @@ Returns the compilation buffer created." (if (or compilation-auto-jump-to-first-error (eq compilation-scroll-output 'first-error)) (setq-local compilation-auto-jump-to-next t)) - ;; Output a mode setter, for saving and later reloading this buffer. - (insert "-*- mode: " name-of-mode - "; default-directory: " - (prin1-to-string (abbreviate-file-name default-directory)) - " -*-\n" - (format "%s started at %s\n\n" + (when (zerop (buffer-size)) + ;; Output a mode setter, for saving and later reloading this buffer. + (insert "-*- mode: " name-of-mode + "; default-directory: " + (prin1-to-string (abbreviate-file-name default-directory)) + " -*-\n")) + (insert (format "%s started at %s\n\n" mode-name (substring (current-time-string) 0 19)) command "\n") @@ -1888,28 +1972,33 @@ Returns the compilation buffer created." (and (derived-mode-p 'comint-mode) (comint-term-environment)) (list (format "INSIDE_EMACS=%s,compile" emacs-version)) + ;; Some external programs (like "git grep") use a pager; + ;; defeat that. + (list "PAGER=") (copy-sequence process-environment)))) (setq-local compilation-arguments (list command mode name-function highlight-regexp)) (setq-local revert-buffer-function 'compilation-revert-buffer) - (and outwin - ;; Forcing the window-start overrides the usual redisplay - ;; feature of bringing point into view, so setting the - ;; window-start to top of the buffer risks losing the - ;; effect of moving point to EOB below, per - ;; compilation-scroll-output, if the command is long - ;; enough to push point outside of the window. This - ;; could happen, e.g., in `rgrep'. - (not compilation-scroll-output) - (set-window-start outwin (point-min))) + (when (and outwin + (not continue) + ;; Forcing the window-start overrides the usual redisplay + ;; feature of bringing point into view, so setting the + ;; window-start to top of the buffer risks losing the + ;; effect of moving point to EOB below, per + ;; compilation-scroll-output, if the command is long + ;; enough to push point outside of the window. This + ;; could happen, e.g., in `rgrep'. + (not compilation-scroll-output)) + (set-window-start outwin (point-min))) ;; Position point as the user will see it. (let ((desired-visible-point - ;; Put it at the end if `compilation-scroll-output' is set. - (if compilation-scroll-output - (point-max) - ;; Normally put it at the top. - (point-min)))) + (cond + (continue continue) + ;; Put it at the end if `compilation-scroll-output' is set. + (compilation-scroll-output (point-max)) + ;; Normally put it at the top. + (t (point-min))))) (goto-char desired-visible-point) (when (and outwin (not (eq outwin (selected-window)))) (set-window-point outwin desired-visible-point))) @@ -2405,8 +2494,8 @@ commands of Compilation major mode are available. See (defun compilation-filter (proc string) "Process filter for compilation buffers. -Just inserts the text, -handles carriage motion (see `comint-inhibit-carriage-motion'), +Just inserts the text, handles carriage motion (see +`comint-inhibit-carriage-motion'), `compilation-hidden-output', and runs `compilation-filter-hook'." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) @@ -2426,13 +2515,18 @@ and runs `compilation-filter-hook'." ;; We used to use `insert-before-markers', so that windows with ;; point at `process-mark' scroll along with the output, but we ;; now use window-point-insertion-type instead. - (insert string) + (if (not compilation-max-output-line-length) + (insert string) + (dolist (line (string-lines string nil t)) + (compilation--insert-abbreviated-line + line compilation-max-output-line-length))) + (when compilation-hidden-output + (compilation--hide-output compilation-filter-start)) (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) ;; Update the number of errors in compilation-mode-line-errors (compilation--ensure-parse (point)) - ;; (setq-local compilation-buffer-modtime (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) @@ -2440,6 +2534,58 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) +(defun compilation--hide-output (start) + (save-excursion + (goto-char start) + (beginning-of-line) + ;; Apply the match to each line, but wait until we have a complete + ;; line. + (let ((start (point))) + (while (search-forward "\n" nil t) + (save-restriction + (narrow-to-region start (point)) + (dolist (regexp (ensure-list compilation-hidden-output)) + (goto-char start) + (while (re-search-forward regexp nil t) + (add-text-properties (match-beginning 0) (match-end 0) + '( invisible t + rear-nonsticky t)))) + (goto-char (point-max))))))) + +(defun compilation--insert-abbreviated-line (string width) + (if (and (> (current-column) 0) + (get-text-property (1- (point)) 'button)) + ;; We already have an abbreviation; just add the string to it. + (let ((beg (point))) + (insert string) + (add-text-properties + beg + ;; Don't make the final newline invisible. + (if (= (aref string (1- (length string))) ?\n) + (1- (point)) + (point)) + (text-properties-at (1- beg)))) + (insert string) + ;; If we exceeded the limit, hide the last portion of the line. + (when (> (current-column) width) + (let ((start (save-excursion + (move-to-column width) + (point)))) + (buttonize-region + start (point) + (lambda (start) + (let ((inhibit-read-only t)) + (remove-text-properties start (save-excursion + (goto-char start) + (line-end-position)) + (text-properties-at start))))) + (put-text-property + start (if (= (aref string (1- (length string))) ?\n) + ;; Don't hide the final newline. + (1- (point)) + (point)) + 'display (if (char-displayable-p ?…) "[…]" "[...]")))))) + (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) @@ -2929,19 +3075,7 @@ and overlay is highlighted between MK and END-MK." (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) -(defun compilation-find-file (marker filename directory &rest formats) - "Find a buffer for file FILENAME. -If FILENAME is not found at all, ask the user where to find it. -Pop up the buffer containing MARKER and scroll to MARKER if we ask -the user where to find the file. -Search the directories in `compilation-search-path'. -A nil in `compilation-search-path' means to try the -\"current\" directory, which is passed in DIRECTORY. -If DIRECTORY is relative, it is combined with `default-directory'. -If DIRECTORY is nil, that means use `default-directory'. -FORMATS, if given, is a list of formats to reformat FILENAME when -looking for it: for each element FMT in FORMATS, this function -attempts to find a file whose name is produced by (format FMT FILENAME)." +(defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) (spec-dir (if directory @@ -2990,6 +3124,23 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs)))) + (list buffer spec-dir))) + +(defun compilation-find-file (marker filename directory &rest formats) + "Find a buffer for file FILENAME. +If FILENAME is not found at all, ask the user where to find it. +Pop up the buffer containing MARKER and scroll to MARKER if we ask +the user where to find the file. +Search the directories in `compilation-search-path'. +A nil in `compilation-search-path' means to try the +\"current\" directory, which is passed in DIRECTORY. +If DIRECTORY is relative, it is combined with `default-directory'. +If DIRECTORY is nil, that means use `default-directory'. +FORMATS, if given, is a list of formats to reformat FILENAME when +looking for it: for each element FMT in FORMATS, this function +attempts to find a file whose name is produced by (format FMT FILENAME)." + (pcase-let ((`(,buffer ,spec-dir) + (compilation-find-file-1 marker filename directory formats))) (while (null buffer) ;Repeat until the user selects an existing file. ;; The file doesn't exist. Ask the user where to find it. (save-excursion ;This save-excursion is probably not right. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8f33b3e3b73..f51d2fcb115 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -64,7 +64,7 @@ ;; This mode supports font-lock, imenu and mode-compile. In the ;; hairy version font-lock is on, but you should activate imenu ;; yourself (note that mode-compile is not standard yet). Well, you -;; can use imenu from keyboard anyway (M-x imenu), but it is better +;; can use imenu from keyboard anyway (M-g i), but it is better ;; to bind it like that: ;; (define-key global-map [M-S-down-mouse-3] 'imenu) @@ -558,6 +558,20 @@ This way enabling/disabling of menu items is more correct." :type 'boolean :group 'cperl-speed) +(defcustom cperl-file-style nil + "Indentation style to use in cperl-mode." + :type '(choice (const "CPerl") + (const "PBP") + (const "PerlStyle") + (const "GNU") + (const "C++") + (const "K&R") + (const "BSD") + (const "Whitesmith") + (const :tag "Default" nil)) + :version "29.1") +;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp) + (defcustom cperl-ps-print-face-properties '((font-lock-keyword-face nil nil bold shadow) (font-lock-variable-name-face nil nil bold) @@ -1077,7 +1091,7 @@ Unless KEEP, removes the old indentation." ["Debugger" cperl-db t] "----" ("Tools" - ["Imenu" imenu (fboundp 'imenu)] + ["Imenu" imenu] ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)] "----" ["Ispell PODs" cperl-pod-spell @@ -1308,7 +1322,7 @@ name, and one for the discovery of a following BLOCK.") ,cperl--ws+-rx (group-n 2 ,cperl--normal-identifier-rx)) "A regular expression to detect a subroutine start. -Contains three groups: One one to distinguish lexical from +Contains three groups: One to distinguish lexical from \"normal\" subroutines, for the keyword \"sub\", and one for the subroutine name.") @@ -1660,9 +1674,11 @@ Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the -corresponding variables. Use \\[cperl-set-style] to do this. Use -\\[cperl-set-style-back] to restore the memorized preexisting values -\(both available from menu). See examples in `cperl-style-examples'. +corresponding variables. Use \\[cperl-set-style] to do this or +set the `cperl-file-style' user option. Use +\\[cperl-set-style-back] to restore the memorized preexisting +values \(both available from menu). See examples in +`cperl-style-examples'. Part of the indentation style is how different parts of if/elsif/else statements are broken into lines; in CPerl, this is reflected on how @@ -1795,8 +1811,15 @@ or as help on variables `cperl-tips', `cperl-problems', (when (and cperl-pod-here-scan (not cperl-syntaxify-by-font-lock)) (cperl-find-pods-heres)) + (when cperl-file-style + (cperl-set-style cperl-file-style)) + (add-hook 'hack-local-variables-hook #'cperl--set-file-style nil t) ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) + +(defun cperl--set-file-style () + (when cperl-file-style + (cperl-set-style cperl-file-style))) ;; Fix for perldb - make default reasonable (defun cperl-db () @@ -3834,7 +3857,7 @@ recursive calls in starting lines of here-documents." "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr "\\(" cperl-white-and-comment-rex - (rx (group (eval cperl--normal-identifier-rx))) + (rx (opt (group (eval cperl--normal-identifier-rx)))) "\\)" "\\(" cperl-maybe-white-and-comment-rex @@ -6313,7 +6336,7 @@ else ) ("Current")) "List of variables to set to get a particular indentation style. -Should be used via `cperl-set-style' or via Perl menu. +Should be used via `cperl-set-style', `cperl-file-style' or via Perl menu. See examples in `cperl-style-examples'.") @@ -6359,7 +6382,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (eval '(mode-compile)))) ; Avoid a warning (declare-function Info-find-node "info" - (filename nodename &optional no-going-back strict-case)) + (filename nodename &optional no-going-back strict-case + noerror)) (defun cperl-info-buffer (type) ;; Return buffer with documentation. Creates if missing. @@ -7056,9 +7080,7 @@ One may build such TAGS files from CPerl mode menu." (error "No items found")) (setq update ;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) - (if (if (fboundp 'display-popup-menus-p) - (display-popup-menus-p) - window-system) + (if (display-popup-menus-p) (x-popup-menu t (nth 2 cperl-hierarchy)) (require 'tmm) (tmm-prompt (nth 2 cperl-hierarchy)))) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 971e3f6174d..03469b9f55b 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -180,9 +180,6 @@ C++ modes are included." (cwarn-font-lock-keywords cwarn-mode) (font-lock-flush)) -;;;###autoload -(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") - ;;}}} ;;{{{ Help functions diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 17cc537e38e..16b2f3ff503 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -996,7 +996,7 @@ if for some reason a circle is in the inheritance graph." Each line corresponds to a class in a class tree. Letters do not insert themselves, they are commands. File operations in the tree buffer work on class tree data structures. -E.g.\\[save-buffer] writes the tree to the file it was loaded from. +E.g. \\[save-buffer] writes the tree to the file it was loaded from. Tree mode key bindings: \\{ebrowse-tree-mode-map}" @@ -3633,7 +3633,12 @@ If regular expression is nil, repeat last search." ;;;###autoload (defun ebrowse-tags-query-replace (from to) "Query replace FROM with TO in all files of a class tree. -With prefix arg, process files of marked classes only." +With prefix arg, process files of marked classes only. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive "sTree query replace (regexp): \nsTree query replace %s by: ") (setq ebrowse-tags-loop-call diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0dfff32f20d..0c4a9bfdbea 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -31,6 +31,7 @@ (require 'cl-generic) (require 'lisp-mode) (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) (define-abbrev-table 'emacs-lisp-mode-abbrev-table () "Abbrev table for Emacs Lisp mode. @@ -51,6 +52,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map." :parent lisp-mode-shared-map "M-TAB" #'completion-at-point "C-M-x" #'eval-defun + "C-c C-e" #'elisp-eval-buffer + "C-c C-f" #'elisp-byte-compile-file + "C-c C-b" #'elisp-byte-compile-buffer "C-M-q" #'indent-pp-sexp) (easy-menu-define emacs-lisp-mode-menu emacs-lisp-mode-map @@ -237,6 +241,26 @@ Comments in the form will be lost." (if (bolp) (delete-char -1)) (indent-region start (point))))) +(defun elisp-mode-syntax-propertize (start end) + (goto-char start) + (let ((case-fold-search nil)) + (funcall + (syntax-propertize-rules + ;; Empty symbol. + ("##" (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) + ;; Unicode character names. (The longest name is 88 characters + ;; long.) + ("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}" + (0 (unless (nth 8 (syntax-ppss)) + (string-to-syntax "_")))) + ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. + (seq (group-n 1 "s") "(") ; Record. + (seq (group-n 1 (+ "^")) "["))) ; Char-table. + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "'"))))) + start end))) + (defcustom emacs-lisp-mode-hook nil "Hook run when entering Emacs Lisp mode." :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) @@ -310,6 +334,7 @@ be used instead. #'elisp-eldoc-var-docstring nil t) (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) + (setq-local syntax-propertize-function #'elisp-mode-syntax-propertize) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local) (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) @@ -606,13 +631,13 @@ functions are annotated with \"<f>\" via the ;; t if in function position. (funpos (eq (char-before beg) ?\()) (quoted (elisp--form-quoted-p beg)) - (fun-sym (condition-case nil - (save-excursion - (up-list -1) - (forward-char 1) - (and (memq (char-syntax (char-after)) '(?w ?_)) - (read (current-buffer)))) - (error nil)))) + (is-ignore-error + (condition-case nil + (save-excursion + (up-list -1) + (forward-char 1) + (looking-at-p "ignore-error\\>")) + (error nil)))) (when (and end (or (not (nth 8 (syntax-ppss))) (memq (char-before beg) '(?` ?‘)))) (let ((table-etc @@ -621,7 +646,7 @@ functions are annotated with \"<f>\" via the ;; FIXME: We could look at the first element of ;; the current form and use it to provide a more ;; specific completion table in more cases. - ((eq fun-sym 'ignore-error) + (is-ignore-error (list t (elisp--completion-local-symbols) :predicate (lambda (sym) (get sym 'error-conditions)))) @@ -676,7 +701,10 @@ functions are annotated with \"<f>\" via the (let ((c (char-after))) (if (eq c ?\() ?\( (if (memq (char-syntax c) '(?w ?_)) - (read (current-buffer)))))) + (let ((pt (point))) + (forward-sexp) + (intern-soft + (buffer-substring pt (point)))))))) (error nil)))) (pcase parent ;; FIXME: Rather than hardcode special cases here, @@ -755,8 +783,8 @@ functions are annotated with \"<f>\" via the ;;; Xref backend -(declare-function xref-make "xref" (summary location)) -(declare-function xref-item-location "xref" (this)) +(declare-function xref-make "progmodes/xref" (summary location)) +(declare-function xref-item-location "progmodes/xref" (this)) (defun elisp--xref-backend () 'elisp) @@ -779,7 +807,7 @@ functions are annotated with \"<f>\" via the (defun elisp--xref-make-xref (type symbol file &optional summary) "Return an xref for TYPE SYMBOL in FILE. TYPE must be a type in `find-function-regexp-alist' (use nil for -'defun). If SUMMARY is non-nil, use it for the summary; +`defun'). If SUMMARY is non-nil, use it for the summary; otherwise build the summary from TYPE and SYMBOL." (xref-make (or summary (format elisp--xref-format (or type 'defun) symbol)) @@ -1202,6 +1230,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map." :parent lisp-mode-shared-map "C-M-x" #'eval-defun "C-M-q" #'indent-pp-sexp + "C-c C-e" #'elisp-eval-buffer + "C-c C-b" #'elisp-byte-compile-buffer "M-TAB" #'completion-at-point "C-j" #'eval-print-last-sexp) @@ -1614,8 +1644,6 @@ Return the result of evaluation." ;; printing, not while evaluating. (defvar elisp--eval-defun-result) (let ((debug-on-error eval-expression-debug-on-error) - (print-length eval-expression-print-length) - (print-level eval-expression-print-level) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1630,10 +1658,17 @@ Return the result of evaluation." (setq beg (point)) (setq form (funcall load-read-function (current-buffer))) (setq end (point))) - ;; Alter the form if necessary. - (let ((form (eval-sexp-add-defvars - (elisp--eval-defun-1 - (macroexpand form))))) + ;; Alter the form if necessary. We bind `print-level' (etc.) + ;; in the form itself, because we want evalling the form to + ;; use the original values, while we want the printing to use + ;; `eval-expression-print-length' (etc.). + (let ((form `(let ((print-level ,print-level) + (print-length ,print-length)) + ,(eval-sexp-add-defvars + (elisp--eval-defun-1 + (macroexpand form))))) + (print-length eval-expression-print-length) + (print-level eval-expression-print-level)) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region @@ -1649,7 +1684,10 @@ Return the result of evaluation." elisp--eval-defun-result)) (defun eval-defun (edebug-it) - "Evaluate the top-level form containing point, or after point. + "Evaluate the top-level form containing point. +If point isn't in a top-level form, evaluate the first top-level +form after point. If there is no top-level form after point, +eval the first preceeding top-level form. If the current defun is actually a call to `defvar' or `defcustom', evaluating it this way resets the variable using its initial value @@ -1714,7 +1752,7 @@ which see." (defalias 'elisp-eldoc-documentation-function 'elisp--documentation-one-liner "Return Elisp documentation for the thing at point as one-line string. This is meant as a backward compatibility aide to the \"old\" -Elisp eldoc behaviour. Consider variable docstrings and function +Elisp eldoc behavior. Consider variable docstrings and function signatures only, in this order. If none applies, returns nil. Changes to `eldoc-documentation-functions' and `eldoc-documentation-strategy' are _not_ reflected here. As such @@ -1737,7 +1775,8 @@ Intended for `eldoc-documentation-functions' (which see)." (defun elisp-eldoc-var-docstring (callback &rest _ignored) "Document variable at point. -Intended for `eldoc-documentation-functions' (which see)." +Intended for `eldoc-documentation-functions' (which see). +Also see `elisp-eldoc-var-docstring-with-value'." (let* ((sym (elisp--current-symbol)) (docstring (and sym (elisp-get-var-docstring sym)))) (when docstring @@ -1745,6 +1784,33 @@ Intended for `eldoc-documentation-functions' (which see)." :thing sym :face 'font-lock-variable-name-face)))) +(defun elisp-eldoc-var-docstring-with-value (callback &rest _) + "Document variable at point. +Intended for `eldoc-documentation-functions' (which see). +Compared to `elisp-eldoc-var-docstring', this also includes the +current variable value and a bigger chunk of the docstring." + (when-let ((cs (elisp--current-symbol))) + (when (and (boundp cs) + ;; nil and t are boundp! + (not (null cs)) + (not (eq cs t))) + (funcall callback + (format "%.100S %s" + (symbol-value cs) + (let* ((doc (documentation-property + cs 'variable-documentation t)) + (more (- (length doc) 1000))) + (concat (propertize + (string-limit (if (string= doc "nil") + "Undocumented." + doc) + 1000) + 'face 'font-lock-doc-face) + (when (> more 0) + (format "[%sc more]" more))))) + :thing cs + :face 'font-lock-variable-name-face)))) + (defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. If SYM is a subr and no arglist is obtainable from the docstring @@ -2062,7 +2128,9 @@ current buffer state and calls REPORT-FN when done." (when (process-live-p elisp-flymake--byte-compile-process) (kill-process elisp-flymake--byte-compile-process))) (let ((temp-file (make-temp-file "elisp-flymake-byte-compile")) - (source-buffer (current-buffer))) + (source-buffer (current-buffer)) + (coding-system-for-write 'utf-8-unix) + (coding-system-for-read 'utf-8)) (save-restriction (widen) (write-region (point-min) (point-max) temp-file nil 'nomessage)) @@ -2083,7 +2151,7 @@ current buffer state and calls REPORT-FN when done." :connection-type 'pipe :sentinel (lambda (proc _event) - (when (eq (process-status proc) 'exit) + (unless (process-live-p proc) (unwind-protect (cond ((not (and (buffer-live-p source-buffer) @@ -2112,6 +2180,8 @@ Runs in a batch-mode Emacs. Interactively use variable (interactive (list buffer-file-name)) (let* ((file (or file (car command-line-args-left))) + (coding-system-for-read 'utf-8-unix) + (coding-system-for-write 'utf-8) (byte-compile-log-buffer (generate-new-buffer " *dummy-byte-compile-log-buffer*")) (byte-compile-dest-file-function #'ignore) @@ -2129,6 +2199,67 @@ Runs in a batch-mode Emacs. Interactively use variable (terpri) (pp collected))) +(defun elisp-eval-buffer () + "Evaluate the forms in the current buffer." + (interactive) + (eval-buffer) + (message "Evaluated the %s buffer" (buffer-name))) + +(defun elisp-byte-compile-file (&optional load) + "Byte compile the file the current buffer is visiting. +If LOAD is non-nil, load the resulting .elc file. When called +interactively, this is the prefix argument." + (interactive "P") + (unless buffer-file-name + (error "This buffer is not visiting a file")) + (byte-compile-file buffer-file-name) + (when load + (load (funcall byte-compile-dest-file-function buffer-file-name)))) + +(defun elisp-byte-compile-buffer (&optional load) + "Byte compile the current buffer, but don't write a file. +If LOAD is non-nil, load byte-compiled data. When called +interactively, this is the prefix argument." + (interactive "P") + (let ((bfn buffer-file-name) + file elc) + (require 'bytecomp) + (unwind-protect + (progn + (setq file (make-temp-file "compile" nil ".el") + elc (funcall byte-compile-dest-file-function file)) + (write-region (point-min) (point-max) file nil 'silent) + (let ((set-message-function + (lambda (message) + (when (string-match-p "\\`Wrote " message) + 'ignore))) + (byte-compile-log-warning-function + (lambda (string position &optional fill level) + (if bfn + ;; Massage the warnings to that they point to + ;; this file, not the one in /tmp. + (let ((byte-compile-current-file bfn) + (byte-compile-root-dir (file-name-directory bfn))) + (byte-compile--log-warning-for-byte-compile + string position fill level)) + ;; We don't have a file name, so the warnings + ;; will point to a file that doesn't exist. This + ;; should be fixed in some way. + (byte-compile--log-warning-for-byte-compile + string position fill level))))) + (byte-compile-file file)) + (when (and bfn (get-buffer "*Compile-Log*")) + (with-current-buffer "*Compile-Log*" + (setq default-directory (file-name-directory bfn)))) + (if load + (load elc) + (message "Byte-compiled the current buffer"))) + (when file + (when (file-exists-p file) + (delete-file file)) + (when (file-exists-p elc) + (delete-file elc)))))) + (put 'read-symbol-shorthands 'safe-local-variable #'consp) diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el index 31a8bded8ad..13da1d478d6 100644 --- a/lisp/progmodes/erts-mode.el +++ b/lisp/progmodes/erts-mode.el @@ -51,25 +51,23 @@ :foreground "blue") (t :bold t)) - "Face used for displaying specificaton values." + "Face used for displaying specification values." :group 'erts-mode) (defface erts-mode-start-test '((t :inherit font-lock-keyword-face)) - "Face used for displaying specificaton test start markers." + "Face used for displaying specification test start markers." :group 'erts-mode) (defface erts-mode-end-test '((t :inherit font-lock-comment-face)) - "Face used for displaying specificaton test start markers." + "Face used for displaying specification test start markers." :group 'erts-mode) -(defvar erts-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map prog-mode-map) - (define-key map "\C-c\C-r" 'erts-tag-region) - (define-key map "\C-c\C-c" 'erts-run-test) - map)) +(defvar-keymap erts-mode-map + :parent prog-mode-map + "C-c C-r" #'erts-tag-region + "C-c C-c" #'erts-run-test) (defvar erts-mode-font-lock-keywords ;; Specifications. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index e1b1e67dbcf..7766694edff 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1839,7 +1839,13 @@ Also see the documentation of the `tags-file-name' variable." Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[fileloop-continue]. -For non-interactive use, superseded by `fileloop-initialize-replace'." + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + +For non-interactive use, this is superseded by `fileloop-initialize-replace'." (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) (fileloop-initialize-replace diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index d7c093444ed..670b6e7e898 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -240,12 +240,13 @@ executable." (not (string= argument (buffer-substring (point) (match-end 1)))) (if (or (not executable-query) no-query-flag - (save-window-excursion - ;; Make buffer visible before question. - (switch-to-buffer (current-buffer)) - (y-or-n-p (format-message - "Replace magic number by `#!%s'? " - argument)))) + (save-match-data + (save-window-excursion + ;; Make buffer visible before question. + (switch-to-buffer (current-buffer)) + (y-or-n-p (format-message + "Replace magic number by `#!%s'? " + argument))))) (progn (replace-match argument t t nil 1) (message "Magic number changed to `#!%s'" argument)))) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 263cd0ef296..dcd74f0369c 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -600,6 +600,7 @@ and variable-name parts, respectively." (append f90-font-lock-keywords-1 (list + '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) ;; Variable declarations (avoid the real function call). ;; NB by accident (?), this correctly fontifies the "integer" in: ;; integer () function foo () @@ -611,8 +612,8 @@ and variable-name parts, respectively." '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\ \\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ -\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)" - (1 font-lock-type-face t) (4 font-lock-variable-name-face t)) +\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\(?:&\n[^&!\n]*\\)*\\)" + (1 font-lock-type-face t) (4 font-lock-variable-name-face append)) ;; Derived type/class variables. ;; TODO ? If we just highlighted the "type" part, rather than ;; "type(...)", this could be in the previous expression. And this @@ -654,7 +655,6 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t '("\\_<\\(namelist\\|common\\)[ \t]*/\\(\\(?:\\sw\\|\\s_\\)+\\)?/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) "\\_<else\\([ \t]*if\\|where\\)?\\_>" - '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) "\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\ return\\)\\_>" '("\\_<\\(exit\\|cycle\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" @@ -825,9 +825,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") :style toggle :help "Expand abbreviations while typing in this buffer"] ["Add Imenu Menu" f90-add-imenu-menu :active (not (lookup-key (current-local-map) [menu-bar index])) - :included (fboundp 'imenu-add-to-menubar) - :help "Add an index menu to the menu-bar" - ])) + :help "Add an index menu to the menu-bar"])) map) "Keymap used in F90 mode.") diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index eebfa70e348..4ab16831bc1 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -903,7 +903,7 @@ can also be executed interactively independently of (defun flymake-proc--delete-temp-directory (dir-name) "Attempt to delete temp dir DIR-NAME, do not fail on error." - (let* ((temp-dir temporary-file-directory) + (let* ((temp-dir (file-truename temporary-file-directory)) (suffix (substring dir-name (1+ (length (directory-file-name temp-dir)))))) (while (> (length suffix) 0) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0c16ddedcbe..0b7958e52fb 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,9 +4,9 @@ ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> ;; Maintainer: João Távora <joaotavora@gmail.com> -;; Version: 1.2.1 +;; Version: 1.2.2 ;; Keywords: c languages tools -;; Package-Requires: ((emacs "28.1") (eldoc "1.1.0") (project "0.7.1")) +;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0") (project "0.7.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. @@ -267,8 +267,8 @@ If set to nil, don't suppress any zero counters." (format " [%s %s]" (or sublog 'flymake) ;; Handle file names with "%" correctly. (Bug#51549) - (string-replace "%" "%%" - (buffer-name (current-buffer)))))) + (replace-regexp-in-string "%" "%%" + (buffer-name (current-buffer)))))) (display-warning (list 'flymake sublog) (apply #'format-message msg args) (if (numberp level) @@ -303,7 +303,7 @@ generated it." (defun flymake-error (text &rest args) "Format TEXT with ARGS and signal an error for Flymake." (let ((msg (apply #'format-message text args))) - (flymake-log :error msg) + (flymake-log :error "%s" msg) (error (concat "[Flymake] " msg)))) (cl-defstruct (flymake--diag @@ -1102,6 +1102,13 @@ The commands `flymake-goto-next-error' and `flymake-goto-prev-error' can be used to navigate among Flymake diagnostics annotated in the buffer. +By default, `flymake-mode' doesn't override the \\[next-error] command, but +if you're using Flymake a lot (and don't use the regular compilation +mechanisms that often), it can be useful to put something like +the following in your init file: + + (setq next-error-function \\='flymake-goto-next-error) + The visual appearance of each type of diagnostic can be changed by setting properties `flymake-overlay-control', `flymake-bitmap' and `flymake-severity' on the symbols of diagnostic types (like @@ -1358,6 +1365,11 @@ This is a suitable place for placing the `flymake-error-counter', Separating each of these with space is not necessary." :type '(repeat (choice string symbol))) +(defcustom flymake-mode-line-lighter "Flymake" + "The string to use in the Flymake mode line." + :type 'string + :version "29.1") + (defvar flymake-mode-line-title '(:eval (flymake--mode-line-title)) "Mode-line construct to show Flymake's mode name and menu.") @@ -1386,7 +1398,7 @@ correctly.") (defun flymake--mode-line-title () `(:propertize - "Flymake" + ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo ,(lambda (&rest _) @@ -1637,6 +1649,8 @@ buffer." (defun flymake-show-buffer-diagnostics () "Show a list of Flymake diagnostics for current buffer." (interactive) + (unless flymake-mode + (user-error "Flymake mode is not enabled in the current buffer")) (let* ((name (flymake--diagnostics-buffer-name)) (source (current-buffer)) (target (or (get-buffer name) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 86f0be7320e..786c5ae8042 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -2213,7 +2213,6 @@ arg DO-SPACE prevents stripping the whitespace." :style toggle :help "Expand abbreviations while typing in this buffer"] ["Add Imenu Menu" imenu-add-menubar-index :active (not (lookup-key (current-local-map) [menu-bar index])) - :included (fboundp 'imenu-add-to-menubar) :help "Add an index menu to the menu-bar"])) (provide 'fortran) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index ddccbe80e7f..21bb75ae0cf 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -90,6 +90,7 @@ (require 'gud) (require 'cl-lib) (require 'cl-seq) +(require 'bindat) (eval-when-compile (require 'pcase)) (declare-function speedbar-change-initial-expansion-list @@ -104,6 +105,7 @@ ;; at toplevel, so the compiler doesn't know under which circumstances ;; they're defined. (declare-function gud-until "gud" (arg)) +(declare-function gud-go "gud" (arg)) (declare-function gud-print "gud" (arg)) (declare-function gud-down "gud" (arg)) (declare-function gud-up "gud" (arg)) @@ -283,8 +285,8 @@ Possible values are: :type '(choice (const :tag "Always restore" t) (const :tag "Don't restore" nil) - (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main) - (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows)) + (const :tag "Depends on `gdb-show-main'" if-gdb-show-main) + (const :tag "Depends on `gdb-many-windows'" if-gdb-many-windows)) :group 'gdb :version "28.1") @@ -682,7 +684,7 @@ Note that this variable only takes effect when variable Until there are such number of source windows on screen, GDB tries to open a new window when visiting a new source file; after that GDB starts to reuse existing source windows." - :type 'number + :type 'natnum :group 'gdb :version "28.1") @@ -954,12 +956,16 @@ detailed description of this mode. (forward-char 2) (gud-call "-exec-until *%a" arg))) "\C-u" "Continue to current line or address.") - ;; TODO Why arg here? (gud-def - gud-go (gud-call (if gdb-active-process - (gdb-gud-context-command "-exec-continue") - "-exec-run") arg) - nil "Start or continue execution.") + gud-go (progn + (when arg + (gud-call (concat "-exec-arguments " + (read-string "Arguments to exec-run: ")))) + (gud-call + (if gdb-active-process + (gdb-gud-context-command "-exec-continue") + "-exec-run"))) + "C-v" "Start or continue execution. Use a prefix to specify arguments.") ;; For debugging Emacs only. (gud-def gud-pp @@ -1138,7 +1144,8 @@ no input, and GDB is waiting for input." (setq name (nth 1 (split-string define "[( ]"))) (push (cons name define) gdb-define-alist)))) -(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) +(declare-function tooltip-show "tooltip" (text &optional use-echo-area + text-face default-face)) (defconst gdb--string-regexp (rx "\"" (* (or (seq "\\" nonl) @@ -1580,7 +1587,7 @@ Buffer mode and name are selected according to buffer type. If buffer has trigger associated with it in `gdb-buffer-rules', this trigger is subscribed to `gdb-buf-publisher' and called with -'update argument." +`update' argument." (or (gdb-get-buffer buffer-type thread) (let ((rules (assoc buffer-type gdb-buffer-rules)) (new (generate-new-buffer "limbo"))) @@ -2105,7 +2112,7 @@ is running." (not (null gdb-running-threads-count)) (> gdb-running-threads-count 0)))) -;; GUD displays the selected GDB frame. This might might not be the current +;; GUD displays the selected GDB frame. This might not be the current ;; GDB frame (after up, down etc). If no GDB frame is visible but the last ;; visited breakpoint is, use that window. (defun gdb-display-source-buffer (buffer) @@ -3080,6 +3087,45 @@ See `def-gdb-auto-update-handler'." 'gdb-breakpoints-mode 'gdb-invalidate-breakpoints) +(defun gdb-breakpoints--add-breakpoint-row (tbl bkpt) + (let ((at (gdb-mi--field bkpt 'at)) + (pending (gdb-mi--field bkpt 'pending)) + (addr (gdb-mi--field bkpt 'addr)) + (func (gdb-mi--field bkpt 'func)) + (type (gdb-mi--field bkpt 'type))) + (if (and (not func) (string-equal addr "<MULTIPLE>")) + (setq func "")) + (gdb-table-add-row tbl + (list + (gdb-mi--field bkpt 'number) + (or type "") + (or (gdb-mi--field bkpt 'disp) "") + (let ((flag (gdb-mi--field bkpt 'enabled))) + (if (string-equal flag "y") + (eval-when-compile + (propertize "y" 'font-lock-face + font-lock-warning-face)) + (eval-when-compile + (propertize "n" 'font-lock-face + font-lock-comment-face)))) + addr + (or (gdb-mi--field bkpt 'times) "") + (if (and type (string-match ".*watchpoint" type)) + (gdb-mi--field bkpt 'what) + (or (and (equal func "") "") + pending at + (concat "in " + (propertize (or func "unknown") + 'font-lock-face + font-lock-function-name-face) + (gdb-frame-location bkpt))))) + ;; Add clickable properties only for + ;; breakpoints with file:line information + (append (list 'gdb-breakpoint bkpt) + (when func + '(help-echo "mouse-2, RET: visit breakpoint" + mouse-face highlight)))))) + (defun gdb-breakpoints-list-handler-custom () (let ((breakpoints-list (gdb-mi--field (gdb-mi--field (gdb-mi--partial-output 'bkpt) @@ -3092,37 +3138,14 @@ See `def-gdb-auto-update-handler'." (add-to-list 'gdb-breakpoints-list (cons (gdb-mi--field breakpoint 'number) breakpoint)) - (let ((at (gdb-mi--field breakpoint 'at)) - (pending (gdb-mi--field breakpoint 'pending)) - (func (gdb-mi--field breakpoint 'func)) - (type (gdb-mi--field breakpoint 'type))) - (gdb-table-add-row table - (list - (gdb-mi--field breakpoint 'number) - (or type "") - (or (gdb-mi--field breakpoint 'disp) "") - (let ((flag (gdb-mi--field breakpoint 'enabled))) - (if (string-equal flag "y") - (eval-when-compile - (propertize "y" 'font-lock-face - font-lock-warning-face)) - (eval-when-compile - (propertize "n" 'font-lock-face - font-lock-comment-face)))) - (gdb-mi--field breakpoint 'addr) - (or (gdb-mi--field breakpoint 'times) "") - (if (and type (string-match ".*watchpoint" type)) - (gdb-mi--field breakpoint 'what) - (or pending at - (concat "in " - (propertize (or func "unknown") - 'font-lock-face font-lock-function-name-face) - (gdb-frame-location breakpoint))))) - ;; Add clickable properties only for breakpoints with file:line - ;; information - (append (list 'gdb-breakpoint breakpoint) - (when func '(help-echo "mouse-2, RET: visit breakpoint" - mouse-face highlight)))))) + ;; Add the breakpoint/header row to the table. + (gdb-breakpoints--add-breakpoint-row table breakpoint) + ;; If this breakpoint has multiple locations, add them as well. + (when-let ((locations (gdb-mi--field breakpoint 'locations))) + (dolist (loc locations) + (add-to-list 'gdb-breakpoints-list + (cons (gdb-mi--field loc 'number) loc)) + (gdb-breakpoints--add-breakpoint-row table loc)))) (insert (gdb-table-string table " ")) (gdb-place-breakpoints))) @@ -4288,7 +4311,7 @@ member." ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. (def-gdb-trigger-and-handler gdb-invalidate-locals - (concat (gdb-current-context-command "-stack-list-locals") + (concat (gdb-current-context-command "-stack-list-variables") " --simple-values") gdb-locals-handler gdb-locals-handler-custom '(start update)) @@ -4299,6 +4322,48 @@ member." 'gdb-locals-mode 'gdb-invalidate-locals) + +;; Retrieve the values of all variables before invalidating locals. +(def-gdb-trigger-and-handler + gdb-locals-values + (concat (gdb-current-context-command "-stack-list-variables") + " --all-values") + gdb-locals-values-handler gdb-locals-values-handler-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-locals-values-buffer + 'gdb-locals-values-buffer-name + 'gdb-locals-mode + 'gdb-locals-values) + +(defun gdb-locals-values-buffer-name () + (gdb-current-context-buffer-name + (concat "local values of " (gdb-get-target-string)))) + +(defcustom gdb-locals-simple-values-only nil + "Only display simple values in the Locals buffer." + :type 'boolean + :group 'gud + :version "29.1") + +(defcustom gdb-locals-value-limit 100 + "Maximum length the value of a local variable is allowed to be." + :type 'integer + :group 'gud + :version "29.1") + +(defvar gdb-locals-values-table (make-hash-table :test #'equal) + "Mapping of local variable names to a string with their value.") + +(defun gdb-locals-values-handler-custom () + "Store the values of local variables in `gdb-locals-value-map'." + (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables))) + (dolist (local locals-list) + (let ((name (bindat-get-field local 'name)) + (value (bindat-get-field local 'value))) + (puthash name value gdb-locals-values-table))))) + (defvar gdb-locals-watch-map (let ((map (make-sparse-keymap))) (suppress-keymap map) @@ -4315,6 +4380,15 @@ member." map) "Keymap to edit value of a simple data type local variable.") +(defun gdb-locals-value-filter (value) + "Filter function for the local variable VALUE." + (let* ((no-nl (replace-regexp-in-string "\n" " " value)) + (str (replace-regexp-in-string "[[:space:]]+" " " no-nl)) + (limit gdb-locals-value-limit)) + (if (>= (length str) limit) + (concat (substring str 0 limit) "...") + str))) + (defun gdb-edit-locals-value (&optional event) "Assign a value to a variable displayed in the locals buffer." (interactive (list last-input-event)) @@ -4327,17 +4401,22 @@ member." (gud-basic-call (concat "-gdb-set variable " var " = " value))))) -;; Don't display values of arrays or structures. -;; These can be expanded using gud-watch. +;; Complex data types are looked up in `gdb-locals-values-table'. (defun gdb-locals-handler-custom () - (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals)) + "Handler to rebuild the local variables table buffer." + (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables)) (table (make-gdb-table))) (dolist (local locals-list) (let ((name (gdb-mi--field local 'name)) (value (gdb-mi--field local 'value)) (type (gdb-mi--field local 'type))) (when (not value) - (setq value "<complex data type>")) + (setq value + (if gdb-locals-simple-values-only + "<complex data type>" + (gethash name gdb-locals-values-table "<unavailable>")))) + (setq value (gdb-locals-value-filter value)) + (if (or (not value) (string-match "0x" value)) (add-text-properties 0 (length name) @@ -4860,6 +4939,8 @@ file\" where the GDB session starts (see `gdb-main-file')." (expand-file-name gdb-default-window-configuration-file gdb-window-configuration-directory))) ;; Create default layout as before. + ;; Make sure that local values are updated before locals. + (gdb-get-buffer-create 'gdb-locals-values-buffer) (gdb-get-buffer-create 'gdb-locals-buffer) (gdb-get-buffer-create 'gdb-stack-buffer) (gdb-get-buffer-create 'gdb-breakpoints-buffer) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index ccc58e6773c..423de7d5818 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -48,8 +48,8 @@ to avoid computing them again.") "Set SYMBOL to VALUE, and update `grep-host-defaults-alist'. SYMBOL should be one of `grep-command', `grep-template', `grep-use-null-device', `grep-find-command' `grep-find-template', -`grep-find-use-xargs', `grep-use-null-filename-separator', or -`grep-highlight-matches'." +`grep-find-use-xargs', `grep-use-null-filename-separator', +`grep-highlight-matches', or `grep-quoting-style'." (when grep-host-defaults-alist (let* ((host-id (intern (or (file-remote-p default-directory) "localhost"))) @@ -202,6 +202,9 @@ by `grep-compute-defaults'; to change the default value, use :set #'grep-apply-setting :version "22.1") +(defvar grep-quoting-style nil + "Whether to use POSIX-like shell argument quoting.") + (defcustom grep-files-aliases '(("all" . "* .*") ("el" . "*.el") @@ -212,6 +215,7 @@ by `grep-compute-defaults'; to change the default value, use ("hh" . "*.hxx *.hpp *.[Hh] *.HH *.h++") ("h" . "*.h") ("l" . "[Cc]hange[Ll]og*") + ("am" . "Makefile.am GNUmakefile *.mk") ("m" . "[Mm]akefile*") ("tex" . "*.tex") ("texi" . "*.texi") @@ -269,16 +273,16 @@ See `compilation-error-screen-columns'." (defvar grep-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map compilation-minor-mode-map) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\^?" 'scroll-down-command) - (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - - (define-key map "\r" 'compile-goto-error) ;; ? - (define-key map "{" 'compilation-previous-file) - (define-key map "}" 'compilation-next-file) - (define-key map "\t" 'compilation-next-error) - (define-key map [backtab] 'compilation-previous-error) + (define-key map " " #'scroll-up-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map "\^?" #'scroll-down-command) + (define-key map "\C-c\C-f" #'next-error-follow-minor-mode) + + (define-key map "\r" #'compile-goto-error) ;; ? + (define-key map "{" #'compilation-previous-file) + (define-key map "}" #'compilation-next-file) + (define-key map "\t" #'compilation-next-error) + (define-key map [backtab] #'compilation-previous-error) map) "Keymap for grep buffers. `compilation-minor-mode-map' is a cdr of this.") @@ -322,24 +326,24 @@ See `compilation-error-screen-columns'." ;; FIXME: Nowadays the last button is not "help" but "search"! (help (last tool-bar-map))) ;; Keep Help last in tool bar (tool-bar-local-item - "left-arrow" 'previous-error-no-select 'previous-error-no-select map + "left-arrow" #'previous-error-no-select #'previous-error-no-select map :rtl "right-arrow" :help "Goto previous match") (tool-bar-local-item - "right-arrow" 'next-error-no-select 'next-error-no-select map + "right-arrow" #'next-error-no-select #'next-error-no-select map :rtl "left-arrow" :help "Goto next match") (tool-bar-local-item - "cancel" 'kill-compilation 'kill-compilation map + "cancel" #'kill-compilation #'kill-compilation map :enable '(let ((buffer (compilation-find-buffer))) (get-buffer-process buffer)) :help "Stop grep") (tool-bar-local-item - "refresh" 'recompile 'recompile map + "refresh" #'recompile #'recompile map :help "Restart grep") (append map help)))) -(defalias 'kill-grep 'kill-compilation) +(defalias 'kill-grep #'kill-compilation) ;; override compilation-last-buffer (defvar grep-last-buffer nil @@ -443,9 +447,9 @@ buffer `default-directory'." (defvar grep-find-abbreviate-properties (let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]")) (map (make-sparse-keymap))) - (define-key map [down-mouse-2] 'mouse-set-point) - (define-key map [mouse-2] 'grep-find-toggle-abbreviation) - (define-key map "\C-m" 'grep-find-toggle-abbreviation) + (define-key map [down-mouse-2] #'mouse-set-point) + (define-key map [mouse-2] #'grep-find-toggle-abbreviation) + (define-key map "\C-m" #'grep-find-toggle-abbreviation) `(face nil display ,ellipsis mouse-face highlight help-echo "RET, mouse-2: show unabbreviated command" keymap ,map abbreviated-command t)) @@ -453,7 +457,7 @@ buffer `default-directory'." (defvar grep-mode-font-lock-keywords '(;; Command output lines. - (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" + (": \\(.\\{,200\\}\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" 1 grep-error-face) ;; remove match from grep-regexp-alist before fontifying ("^Grep[/a-zA-Z]* started.*" @@ -616,8 +620,8 @@ This function is called from `compilation-filter-hook'." "Compute the defaults for the `grep' command. The value depends on `grep-command', `grep-template', `grep-use-null-device', `grep-find-command', `grep-find-template', -`grep-use-null-filename-separator', `grep-find-use-xargs' and -`grep-highlight-matches'." +`grep-use-null-filename-separator', `grep-find-use-xargs', +`grep-highlight-matches', and `grep-quoting-style'." ;; Keep default values. (unless grep-host-defaults-alist (add-to-list @@ -631,13 +635,14 @@ The value depends on `grep-command', `grep-template', (grep-use-null-filename-separator ,grep-use-null-filename-separator) (grep-find-use-xargs ,grep-find-use-xargs) - (grep-highlight-matches ,grep-highlight-matches))))) - (let* ((host-id - (intern (or (file-remote-p default-directory) "localhost"))) + (grep-highlight-matches ,grep-highlight-matches) + (grep-quoting-style ,grep-quoting-style))))) + (let* ((remote (file-remote-p default-directory)) + (host-id (intern (or remote "localhost"))) (host-defaults (assq host-id grep-host-defaults-alist)) (defaults (assq nil grep-host-defaults-alist)) - (quot-braces (shell-quote-argument "{}")) - (quot-scolon (shell-quote-argument ";"))) + (quot-braces (shell-quote-argument "{}" remote)) + (quot-scolon (shell-quote-argument ";" remote))) ;; There are different defaults on different hosts. They must be ;; computed for every host once. (dolist (setting '(grep-command grep-template @@ -791,8 +796,11 @@ The value depends on `grep-command', `grep-template', find-program gcmd null quot-braces)) (t (format "%s -H <D> <X> -type f <F> -print | \"%s\" %s" - find-program xargs-program gcmd)))))))) - ;; Save defaults for this host. + find-program xargs-program gcmd)))))) + + (setq grep-quoting-style (and remote 'posix)))) + + ;; Save defaults for this host. (setq grep-host-defaults-alist (delete (assq host-id grep-host-defaults-alist) grep-host-defaults-alist)) @@ -807,7 +815,8 @@ The value depends on `grep-command', `grep-template', (grep-use-null-filename-separator ,grep-use-null-filename-separator) (grep-find-use-xargs ,grep-find-use-xargs) - (grep-highlight-matches ,grep-highlight-matches)))))) + (grep-highlight-matches ,grep-highlight-matches) + (grep-quoting-style ,grep-quoting-style)))))) (defun grep-tag-default () (or (and transient-mark-mode mark-active @@ -820,7 +829,8 @@ The value depends on `grep-command', `grep-template', (defun grep-default-command () "Compute the default grep command for \\[universal-argument] \\[grep] to offer." - (let ((tag-default (shell-quote-argument (grep-tag-default))) + (let ((tag-default + (shell-quote-argument (grep-tag-default) grep-quoting-style)) ;; This a regexp to match single shell arguments. ;; Could someone please add comments explaining it? (sh-arg-re @@ -875,6 +885,14 @@ The value depends on `grep-command', `grep-template', (setq-local compilation-disable-input t) (setq-local compilation-error-screen-columns grep-error-screen-columns) + ;; We normally use a nul byte to separate the file name from the + ;; contents, but display it as ":". That's fine, but when yanking + ;; to other buffers, it's annoying to have the nul byte there. + (unless kill-transform-function + (setq-local kill-transform-function #'identity)) + (add-function :filter-return (local 'kill-transform-function) + (lambda (string) + (string-replace "\0" ":" string))) (add-hook 'compilation-filter-hook #'grep-filter nil t)) (defun grep--save-buffers () @@ -952,8 +970,7 @@ easily repeat a find command." (grep command-args)))) ;;;###autoload -(defalias 'find-grep 'grep-find) - +(defalias 'find-grep #'grep-find) ;; User-friendly interactive API. @@ -963,7 +980,7 @@ easily repeat a find command." ("<F>" . files) ("<N>" . (null-device)) ("<X>" . excl) - ("<R>" . (shell-quote-argument (or regexp "")))) + ("<R>" . (shell-quote-argument (or regexp "") grep-quoting-style))) "List of substitutions performed by `grep-expand-template'. If car of an element matches, the cdr is evalled in order to get the substitution string. @@ -1010,7 +1027,7 @@ these include `opts', `dir', `files', `null-device', `excl' and ;; Instead of a `grep-read-files-function' variable, we used to lookup ;; mode-specific functions in the major mode's symbol properties, so preserve ;; this behavior for backward compatibility. - (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1 + (let ((old-function (get major-mode #'grep-read-files))) ;Obsolete since 28.1 (if old-function (funcall old-function) (let ((file-name-at-point @@ -1057,15 +1074,18 @@ REGEXP is used as a string in the prompt." default-extension (car grep-files-history) (car (car grep-files-aliases)))) + (defaults + (delete-dups + (delq nil + (append (list default default-alias default-extension) + (mapcar #'car grep-files-aliases))))) (files (completing-read (format-prompt "Search for \"%s\" in files matching wildcard" default regexp) - #'read-file-name-internal - nil nil nil 'grep-files-history - (delete-dups - (delq nil - (append (list default default-alias default-extension) - (mapcar #'car grep-files-aliases))))))) + (completion-table-merge + (lambda (_string _pred _action) defaults) + #'read-file-name-internal) + nil nil nil 'grep-files-history defaults))) (and files (or (cdr (assoc files grep-files-aliases)) files)))) @@ -1112,6 +1132,9 @@ command before it's run." (when (and (stringp regexp) (> (length regexp) 0)) (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) + (unless (string-equal (file-remote-p dir) (file-remote-p default-directory)) + (let ((default-directory dir)) + (grep-compute-defaults))) (let ((command regexp)) (if (null files) (if (string= command grep-command) @@ -1134,11 +1157,13 @@ command before it's run." (mapconcat (lambda (ignore) (cond ((stringp ignore) - (shell-quote-argument ignore)) + (shell-quote-argument + ignore grep-quoting-style)) ((consp ignore) (and (funcall (car ignore) dir) (shell-quote-argument - (cdr ignore)))))) + (cdr ignore) + grep-quoting-style))))) grep-find-ignored-files " --exclude="))) (and (eq grep-use-directories-skip t) @@ -1158,7 +1183,7 @@ command before it's run." (if (and grep-use-null-device null-device (null-device)) (concat command " " (null-device)) command) - 'grep-mode)) + #'grep-mode)) ;; Set default-directory if we started lgrep in the *grep* buffer. (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) @@ -1191,7 +1216,11 @@ When called programmatically and FILES is nil, REGEXP is expected to specify a command to run. If CONFIRM is non-nil, the user will be given an opportunity to edit the -command before it's run." +command before it's run. + +Interactively, the user can use the \\`M-c' command while entering +the regexp to indicate whether the grep should be case sensitive +or not." (interactive (progn (grep-compute-defaults) @@ -1210,13 +1239,17 @@ command before it's run." (when (and (stringp regexp) (> (length regexp) 0)) (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) + (unless (string-equal (file-remote-p dir) (file-remote-p default-directory)) + (let ((default-directory dir)) + (grep-compute-defaults))) (if (null files) (if (not (string= regexp (if (consp grep-find-command) (car grep-find-command) grep-find-command))) - (compilation-start regexp 'grep-mode)) + (compilation-start regexp #'grep-mode)) (setq dir (file-name-as-directory (expand-file-name dir))) - (let ((command (rgrep-default-command regexp files nil))) + (let* ((case-fold-search (read-regexp-case-fold-search regexp)) + (command (rgrep-default-command regexp files nil))) (when command (if confirm (setq command @@ -1225,7 +1258,7 @@ command before it's run." (add-to-history 'grep-find-history command)) (grep--save-buffers) (let ((default-directory dir)) - (compilation-start command 'grep-mode)) + (compilation-start command #'grep-mode)) ;; Set default-directory if we started rgrep in the *grep* buffer. (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir))))))) @@ -1245,44 +1278,46 @@ command before it's run." (grep-expand-template grep-find-template regexp - (concat (shell-quote-argument "(") + (concat (shell-quote-argument "(" grep-quoting-style) " " find-name-arg " " (mapconcat - #'shell-quote-argument + (lambda (x) (shell-quote-argument x grep-quoting-style)) (split-string files) (concat " -o " find-name-arg " ")) " " - (shell-quote-argument ")")) + (shell-quote-argument ")" grep-quoting-style)) dir (concat (and grep-find-ignored-directories (concat "-type d " - (shell-quote-argument "(") + (shell-quote-argument "(" grep-quoting-style) ;; we should use shell-quote-argument here " -path " - (mapconcat (lambda (d) (shell-quote-argument (concat "*/" d))) - (rgrep-find-ignored-directories dir) - " -o -path ") + (mapconcat + (lambda (d) + (shell-quote-argument (concat "*/" d) grep-quoting-style)) + (rgrep-find-ignored-directories dir) + " -o -path ") " " - (shell-quote-argument ")") + (shell-quote-argument ")" grep-quoting-style) " -prune -o ")) (and grep-find-ignored-files - (concat (shell-quote-argument "!") " -type d " - (shell-quote-argument "(") + (concat (shell-quote-argument "!" grep-quoting-style) " -type d " + (shell-quote-argument "(" grep-quoting-style) ;; we should use shell-quote-argument here " -name " (mapconcat (lambda (ignore) (cond ((stringp ignore) - (shell-quote-argument ignore)) + (shell-quote-argument ignore grep-quoting-style)) ((consp ignore) (and (funcall (car ignore) dir) (shell-quote-argument - (cdr ignore)))))) + (cdr ignore) grep-quoting-style))))) grep-find-ignored-files " -o -name ") " " - (shell-quote-argument ")") + (shell-quote-argument ")" grep-quoting-style) " -prune -o "))))) (defun grep-find-toggle-abbreviation () @@ -1352,7 +1387,7 @@ The returned file name is relative." (caar (compilation--loc->file-struct loc)))) ;;;###autoload -(defalias 'rzgrep 'zrgrep) +(defalias 'rzgrep #'zrgrep) (provide 'grep) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index b1bef82842d..be43effed7d 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -54,8 +54,8 @@ (declare-function gdb-tooltip-print-1 "gdb-mi" (expr)) (declare-function gud-pp "gdb-mi" (arg)) (declare-function gdb-var-delete "gdb-mi" ()) -(declare-function speedbar-toggle-line-expansion "gud" ()) -(declare-function speedbar-edit-line "gud" ()) +(declare-function speedbar-toggle-line-expansion "speedbar" ()) +(declare-function speedbar-edit-line "speedbar" ()) ;; FIXME: The declares below are necessary because we don't call `gud-def' ;; at toplevel, so the compiler doesn't know under which circumstances ;; they're defined. @@ -334,7 +334,7 @@ Used to gray out relevant toolbar icons.") (">" . gud-down))) (define-key map key cmd)) map) - "Keymap to repeat `gud-gdb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `gud-gdb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defun gud-set-repeat-map-property (keymap-symbol) @@ -744,10 +744,10 @@ The option \"--fullname\" must be included in this value." output)) -(easy-mmode-defmap gud-minibuffer-local-map - '(("\C-i" . comint-dynamic-complete-filename)) - "Keymap for minibuffer prompting of gud startup command." - :inherit minibuffer-local-map) +(defvar-keymap gud-minibuffer-local-map + :doc "Keymap for minibuffer prompting of gud startup command." + :parent minibuffer-local-map + "C-i" #'comint-dynamic-complete-filename) (defun gud-query-cmdline (minor-mode &optional init) (let* ((hist-sym (gud-symbol 'history nil minor-mode)) @@ -759,13 +759,18 @@ The option \"--fullname\" must be included in this value." (concat (or cmd-name (symbol-name minor-mode)) " " (or init - (let ((file nil)) - (dolist (f (directory-files default-directory) file) - (if (and (file-executable-p f) - (not (file-directory-p f)) - (or (not file) - (file-newer-than-file-p f file))) - (setq file f))))))) + (let ((file nil) + (files (directory-files default-directory))) + ;; On remote systems, this may be slow, so avoid it. + (when (or (not (file-remote-p default-directory)) + (length< files 50)) + (dolist (f files) + (if (and (file-executable-p f) + (not (file-directory-p f)) + (or (not file) + (file-newer-than-file-p f file))) + (setq file f))) + file))))) gud-minibuffer-local-map nil hist-sym))) @@ -869,7 +874,8 @@ the buffer in which this command was invoked." COMMAND is the prefix for which we seek completion. CONTEXT is the text before COMMAND on the line." (let* ((complete-list - (gud-gdb-run-command-fetch-lines (concat "complete " context command) + (gud-gdb-run-command-fetch-lines (concat "server complete " + context command) (current-buffer) ;; From string-match above. (length context)))) @@ -1048,7 +1054,7 @@ SKIP is the number of chars to skip on each line, it defaults to 0." ("l" . gud-refresh))) (define-key map key cmd)) map) - "Keymap to repeat `sdb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `sdb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defun gud-sdb-marker-filter (string) @@ -1295,7 +1301,7 @@ whereby $stopformat=1 produces an output format compatible with gud-irix-p) (define-key map "f" 'gud-finish)) map) - "Keymap to repeat `dbx' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `dbx' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") ;; The process filter is also somewhat @@ -1470,7 +1476,7 @@ and source-file directory for your debugger." (">" . gud-down))) (define-key map key cmd)) map) - "Keymap to repeat `xdb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `xdb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defcustom gud-xdb-directories nil @@ -1558,7 +1564,7 @@ directories if your program contains sources from more than one directory." ("l" . gud-refresh))) (define-key map key cmd)) map) - "Keymap to repeat `perldb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `perldb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defun gud-perldb-massage-args (_file args) @@ -1748,7 +1754,7 @@ working directory and source-file directory for your debugger." (">" . gud-down))) (define-key map key cmd)) map) - "Keymap to repeat `pdb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `pdb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") ;; There's no guarantee that Emacs will hand the filter the entire @@ -1865,7 +1871,7 @@ directory and source-file directory for your debugger." (">" . gud-down))) (define-key map key cmd)) map) - "Keymap to repeat `guiler' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `guiler' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defun gud-guiler-marker-filter (string) @@ -2392,7 +2398,7 @@ extension EXTN. Normally EXTN is given as the regular expression ("l" . gud-refresh))) (define-key map key cmd)) map) - "Keymap to repeat `jdb' stepping instructions `C-x C-a C-n n n'. + "Keymap to repeat `jdb' stepping instructions \\`C-x C-a C-n n n'. Used in `repeat-mode'.") (defun gud-jdb-find-source-using-classpath (p) @@ -2454,7 +2460,7 @@ during jdb initialization depending on the value of ;; not supported/followed) (if (and gud-jdb-use-classpath (not gud-jdb-classpath-string) - (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc) + (or (string-match "classpath:[ \t[]+\\([^]]*\\)" gud-marker-acc) (string-match "-classpath[ \t\"]+\\([^ \"]+\\)" gud-marker-acc))) (setq gud-jdb-classpath (gud-jdb-parse-classpath-string @@ -3688,7 +3694,6 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (message "Dereferencing is now %s." (if gud-tooltip-dereference "on" "off"))) -(defvar tooltip-use-echo-area) (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) (declare-function tooltip-strip-prompt "tooltip" (process output)) @@ -3702,8 +3707,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." "Process debugger output and show it in a tooltip window." (remove-function (process-filter process) #'gud-tooltip-process-output) (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not tooltip-mode)))) + (or gud-tooltip-echo-area (not tooltip-mode)))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." @@ -3747,8 +3751,7 @@ This function must return nil if it doesn't handle EVENT." (unless (null define-elt) (tooltip-show (cdr define-elt) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not tooltip-mode))) + (or gud-tooltip-echo-area (not tooltip-mode))) expr)))) (when gud-tooltip-dereference (setq expr (concat "*" expr))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index ba2c5737480..f2ada676ab7 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -109,7 +109,7 @@ ;; ;; Extensively modified by Luke Lee in 2013 to support complete C expression ;; evaluation and argumented macro expansion; C++11, C++14, C++17, GCC -;; extension literals and gcc/clang matching behaviours are supported in 2021. +;; extension literals and gcc/clang matching behaviors are supported in 2021. ;; Various floating point types and operations are also supported but the ;; actual precision is limited by the Emacs internal floating representation, ;; which is the C data type "double" or IEEE binary64 format. diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index e1ee9efc54b..ec281f3a496 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -31,17 +31,16 @@ "Abbrev table in use in Icon-mode buffers.") (define-abbrev-table 'icon-mode-abbrev-table ()) -(defvar icon-mode-map - (let ((map (make-sparse-keymap "Icon"))) - (define-key map "{" 'electric-icon-brace) - (define-key map "}" 'electric-icon-brace) - (define-key map "\e\C-h" 'mark-icon-function) - (define-key map "\e\C-a" 'beginning-of-icon-defun) - (define-key map "\e\C-e" 'end-of-icon-defun) - (define-key map "\e\C-q" 'indent-icon-exp) - (define-key map "\177" 'backward-delete-char-untabify) - map) - "Keymap used in Icon mode.") +(defvar-keymap icon-mode-map + :doc "Keymap used in Icon mode." + :name "Icon" + "{" #'electric-icon-brace + "}" #'electric-icon-brace + "C-M-h" #'mark-icon-function + "C-M-a" #'beginning-of-icon-defun + "C-M-e" #'end-of-icon-defun + "C-M-q" #'indent-icon-exp + "DEL" #'backward-delete-char-untabify) (easy-menu-define icon-mode-menu icon-mode-map "Menu for Icon mode." diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index b6063521365..d21a9faec9d 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -231,7 +231,7 @@ because these are used as separators by IDL." (defcustom idlwave-shell-graphics-window-size '(500 400) "Size of IDL graphics windows popped up by special IDLWAVE command. -The command is `C-c C-d C-f' and accepts as a prefix the window nr. +The command is \\`C-c C-d C-f' and accepts as a prefix the window nr. A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL." :group 'idlwave-shell-general-setup :type '(list @@ -844,7 +844,7 @@ IDL has currently stepped.") --------- A complete set of commands for compiling and debugging IDL programs is available from the menu. Also keybindings starting with a - `C-c C-d' prefix are available for most commands in the *idl* buffer + \\`C-c C-d' prefix are available for most commands in the *idl* buffer and also in source buffers. The best place to learn about the keybindings is again the menu. diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index e3985db64ab..a2061fde762 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1001,9 +1001,9 @@ Obsolete, if the IDL Assistant is being used for help." "List of modifiers to be used for the debugging commands. Will be used to bind debugging commands in the shell buffer and in all source buffers. These are additional convenience bindings, the debugging -commands are always available with the `C-c C-d' prefix. +commands are always available with the \\`C-c C-d' prefix. If you set this to (control shift), this means setting a breakpoint will -be on `C-S-b', compiling a source file on `C-S-c' etc. Possible modifiers +be on \\`C-S-b', compiling a source file on \\`C-S-c' etc. Possible modifiers are `control', `meta', `super', `hyper', `alt', and `shift'." :group 'idlwave-shell-general-setup :type '(set :tag "Specify modifiers" @@ -1353,7 +1353,7 @@ the leftover unidentified statements containing an equal sign.") ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. -(defvar idlwave-comment-indent-char ?\ +(defvar idlwave-comment-indent-char ?\s "Character to be inserted for IDL comment indentation. Normally a space.") @@ -3247,7 +3247,7 @@ ignored." ;; In the following while statements, after one iteration ;; point will be at the beginning of a line in which case ;; the while will not be executed for the - ;; the first paragraph line and thus will not affect the + ;; first paragraph line and thus will not affect the ;; indentation. ;; ;; First check to see if indentation is based on hanging indent. @@ -8421,7 +8421,7 @@ was pressed." (defun idlwave-list-shell-load-path-shadows (&optional _arg) "List the load path shadows of all routines compiled under the shell. This is very useful for checking an IDL application. Just compile the -application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced +application, do RESOLVE_ALL, and \\`C-c C-i' to compile all referenced routines and update IDLWAVE internal info. Then check for shadowing with this command." (interactive) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9c1358e466d..eb2a1e4fccc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -660,13 +660,11 @@ This variable is like `sgml-attribute-offset'." :type 'integer :safe 'integerp) -;;; KeyMap +;;; Keymap -(defvar js-mode-map - (let ((keymap (make-sparse-keymap))) - (define-key keymap [(meta ?.)] #'js-find-symbol) - keymap) - "Keymap for `js-mode'.") +(defvar-keymap js-mode-map + :doc "Keymap for `js-mode'." + "M-." #'js-find-symbol) ;;; Syntax table and parsing diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index b9fcd033bbb..a18c8bcce44 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -121,13 +121,11 @@ If m4 is not in your PATH, set this to an absolute file name." ("#" (0 (when (m4--quoted-p (match-beginning 0)) (string-to-syntax ".")))))) -(defvar m4-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-b" 'm4-m4-buffer) - (define-key map "\C-c\C-r" 'm4-m4-region) - (define-key map "\C-c\C-c" 'comment-region) - map) - "Keymap for M4 Mode.") +(defvar-keymap m4-mode-map + :doc "Keymap for M4 Mode." + "C-c C-b" #'m4-m4-buffer + "C-c C-r" #'m4-m4-region + "C-c C-c" #'comment-region) (easy-menu-define m4-mode-menu m4-mode-map "Menu for M4 Mode." diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 91307f6c09f..bd01786e08c 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1170,7 +1170,6 @@ and adds all qualifying names to the list of known targets." (goto-char (match-end 0)) (insert suffix)))))))) -(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1") ;; Backslashification. Stolen from cc-mode.el. diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 5aaa277431a..f0fd23f3bc3 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -108,30 +108,27 @@ (macro-keywords-2 "\\(primarydef\\|secondarydef\\|tertiarydef\\)") (args-keywords - (eval-when-compile - (regexp-opt - '("expr" "suffix" "text" "primary" "secondary" "tertiary") - t))) + (regexp-opt + '("expr" "suffix" "text" "primary" "secondary" "tertiary") + t)) (type-keywords - (eval-when-compile - (regexp-opt - '("boolean" "color" "numeric" "pair" "path" "pen" "picture" - "string" "transform" "newinternal") - t))) + (regexp-opt + '("boolean" "color" "numeric" "pair" "path" "pen" "picture" + "string" "transform" "newinternal") + t)) (syntactic-keywords - (eval-when-compile - (regexp-opt - '("for" "forever" "forsuffixes" "endfor" - "step" "until" "upto" "downto" "thru" "within" - "iff" "if" "elseif" "else" "fi" "exitif" "exitunless" - "let" "def" "vardef" "enddef" "mode_def" - "true" "false" "known" "unknown" "and" "or" "not" - "save" "interim" "inner" "outer" "relax" - "begingroup" "endgroup" "expandafter" "scantokens" - "generate" "input" "endinput" "end" "bye" - "message" "errmessage" "errhelp" "special" "numspecial" - "readstring" "readfrom" "write") - t))) + (regexp-opt + '("for" "forever" "forsuffixes" "endfor" + "step" "until" "upto" "downto" "thru" "within" + "iff" "if" "elseif" "else" "fi" "exitif" "exitunless" + "let" "def" "vardef" "enddef" "mode_def" + "true" "false" "known" "unknown" "and" "or" "not" + "save" "interim" "inner" "outer" "relax" + "begingroup" "endgroup" "expandafter" "scantokens" + "generate" "input" "endinput" "end" "bye" + "message" "errmessage" "errhelp" "special" "numspecial" + "readstring" "readfrom" "write") + t)) ) (list ;; embedded TeX code in btex ... etex @@ -441,8 +438,6 @@ If the list was changed, sort the list and remove duplicates first." (insert close))))))) (nth 1 entry)))) -(define-obsolete-function-alias 'meta-complete-symbol - 'completion-at-point "24.1") ;;; Indentation. @@ -806,7 +801,6 @@ The environment marked is the one that contains point or follows point." st) "Syntax table used in Metafont or MetaPost mode.") -(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1") (defvar meta-common-mode-map (let ((map (make-sparse-keymap))) ;; Comment Paragraphs: diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 97a218fcfa3..9d1ceaa55a8 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -78,16 +78,13 @@ ;;; Code: (defvar compile-command) -;;; Key map -(defvar mixal-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'compile) - (define-key map "\C-c\C-r" 'mixal-run) - (define-key map "\C-c\C-d" 'mixal-debug) - (define-key map "\C-h\C-o" 'mixal-describe-operation-code) - map) - "Keymap for `mixal-mode'.") -;; (makunbound 'mixal-mode-map) +;;; Keymap +(defvar-keymap mixal-mode-map + :doc "Keymap for `mixal-mode'." + "C-c C-c" #'compile + "C-c C-r" #'mixal-run + "C-c C-d" #'mixal-debug + "C-h C-o" #'mixal-describe-operation-code) ;;; Syntax table (defvar mixal-mode-syntax-table diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index a8d644dba0e..e668570ba17 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -101,9 +101,8 @@ (defcustom m2-indent 5 "This variable gives the indentation in Modula-2 mode." - :type 'integer) -(put 'm2-indent 'safe-local-variable - (lambda (v) (or (null v) (integerp v)))) + :type 'integer + :safe (lambda (v) (or (null v) (integerp v)))) (defconst m2-smie-grammar ;; An official definition can be found as "M2R10.pdf". This grammar does diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ecc9386cae3..721dfa51ad3 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -197,8 +197,8 @@ newline or semicolon after an else or end keyword." (defcustom octave-block-offset 2 "Extra indentation applied to statements in Octave block structures." - :type 'integer) -(put 'octave-block-offset 'safe-local-variable 'integerp) + :type 'integer + :safe #'integerp) (defvar octave-block-comment-start (concat (make-string 2 octave-comment-char) " ") @@ -879,7 +879,8 @@ startup file, `~/.emacs-octave'." (set-process-filter proc 'comint-output-filter) ;; Just in case, to be sure a cd in the startup file won't have ;; detrimental effects. - (with-demoted-errors (inferior-octave-resync-dirs)) + (with-demoted-errors "Octave resync error: %S" + (inferior-octave-resync-dirs)) ;; Generate a proper prompt, which is critical to ;; `comint-history-isearch-backward-regexp'. Bug#14433. (comint-send-string proc "\n"))) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 4ab9b4a9962..63399adf3ae 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1641,10 +1641,10 @@ An error is raised if not in a comment." (defun opascal-new-comment-line () "If in a // comment, do a newline, indented such that one is still in the comment block. If not in a // comment, just does a normal newline." - (interactive) (declare (obsolete "use comment-indent-new-line with comment-multi-line instead" "27.1")) + (interactive) (let ((comment (opascal-current-token))) (if (not (eq 'comment-single-line (opascal-token-kind comment))) ;; Not in a // comment. Just do the normal newline. diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 8dc03b72b1e..8d3194e6a47 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -47,8 +47,8 @@ ;; "reset" "rewrite" "write" "writeln") ;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) -;; KNOWN BUGS / BUGREPORTS -;; ======================= +;; KNOWN BUGS / BUG REPORTS +;; ======================== ;; As far as I know, there are no bugs in the current version of this ;; package. This may not be true however, since I never use this mode ;; myself and therefore would never notice them anyway. If you do @@ -239,14 +239,6 @@ will do all lineups." (const :tag "Declarations" declaration) (const :tag "Case statements" case))) -(defvar pascal-toggle-completions nil - "If non-nil, `pascal-complete-word' tries all possible completions. -Repeated use of \\[pascal-complete-word] then shows all -completions in turn, instead of displaying a list of all possible -completions.") -(make-obsolete-variable 'pascal-toggle-completions - 'completion-cycle-threshold "24.1") - (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") "Keywords for types used when completing a word in a declaration or parmlist. @@ -1297,13 +1289,6 @@ indent of the current line in parameterlist." (when (> e b) (list b e #'pascal-completion)))) -(define-obsolete-function-alias 'pascal-complete-word - 'completion-at-point "24.1") - -(define-obsolete-function-alias 'pascal-show-completions - 'completion-help-at-point "24.1") - - (defun pascal-get-default-symbol () "Return symbol around current point as a string." (save-excursion @@ -1382,8 +1367,6 @@ The default is a name found in the buffer around point." ;;; (defvar pascal-outline-map (let ((map (make-sparse-keymap))) - (if (fboundp 'set-keymap-name) - (set-keymap-name map 'pascal-outline-map)) (define-key map "\M-\C-a" 'pascal-outline-prev-defun) (define-key map "\M-\C-e" 'pascal-outline-next-defun) (define-key map "\C-c\C-d" 'pascal-outline-goto-defun) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 120237b960e..6019840048a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. ;; Version: 0.8.1 -;; Package-Requires: ((emacs "26.1") (xref "1.0.2")) +;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that ;; not compatible with the version of Emacs recorded above. @@ -404,6 +404,12 @@ you might have to restart Emacs to see the effect." :package-version '(project . "0.2.0") :safe #'booleanp) +(defcustom project-vc-include-untracked t + "When non-nil, the VC project backend includes untracked files." + :type 'boolean + :version "29.1" + :safe #'booleanp) + ;; FIXME: Using the current approach, major modes are supposed to set ;; this variable to a buffer-local value. So we don't have access to ;; the "external roots" of language A from buffers of language B, which @@ -440,30 +446,33 @@ The directory names should be absolute. Used in the VC project backend implementation of `project-external-roots'.") (defun project-try-vc (dir) - (let* ((backend - ;; FIXME: This is slow. Cache it. - (ignore-errors (vc-responsible-backend dir))) - (root - (pcase backend - ('Git - ;; Don't stop at submodule boundary. - ;; FIXME: Cache for a shorter time. - (or (vc-file-getprop dir 'project-git-root) - (let ((root (vc-call-backend backend 'root dir))) - (vc-file-setprop - dir 'project-git-root - (if (and - ;; FIXME: Invalidate the cache when the value - ;; of this variable changes. - (project--vc-merge-submodules-p root) - (project--submodule-p root)) - (let* ((parent (file-name-directory - (directory-file-name root)))) - (vc-call-backend backend 'root parent)) - root))))) - ('nil nil) - (_ (ignore-errors (vc-call-backend backend 'root dir)))))) - (and root (cons 'vc root)))) + (or (vc-file-getprop dir 'project-vc) + (let* ((backend (ignore-errors (vc-responsible-backend dir))) + (root + (pcase backend + ('Git + ;; Don't stop at submodule boundary. + (or (vc-file-getprop dir 'project-git-root) + (let ((root (vc-call-backend backend 'root dir))) + (vc-file-setprop + dir 'project-git-root + (if (and + ;; FIXME: Invalidate the cache when the value + ;; of this variable changes. + (project--vc-merge-submodules-p root) + (project--submodule-p root)) + (let* ((parent (file-name-directory + (directory-file-name root)))) + (vc-call-backend backend 'root parent)) + root))))) + ('nil nil) + (_ (ignore-errors (vc-call-backend backend 'root dir))))) + project) + (when root + (setq project (list 'vc backend root)) + ;; FIXME: Cache for a shorter time. + (vc-file-setprop dir 'project-vc project) + project)))) (defun project--submodule-p (root) ;; XXX: We only support Git submodules for now. @@ -489,7 +498,7 @@ backend implementation of `project-external-roots'.") (t nil)))) (cl-defmethod project-root ((project (head vc))) - (cdr project)) + (nth 2 project)) (cl-defmethod project-external-roots ((project (head vc))) (project-subtract-directories @@ -556,7 +565,8 @@ backend implementation of `project-external-roots'.") files) ;; Include unregistered. (setq args (append args - '("-c" "-o") + '("-c") + (and project-vc-include-untracked '("-o")) (unless no-gitignore '("--exclude-standard")))) (when (or files extra-ignores) (setq args (append args @@ -591,9 +601,9 @@ backend implementation of `project-external-roots'.") (delete-consecutive-dups files))) (`Hg (let ((default-directory (expand-file-name (file-name-as-directory dir))) - args) - ;; Include unregistered. - (setq args (nconc args '("-mcardu" "--no-status" "-0"))) + (args (list (concat "-mcard" (and project-vc-include-untracked "u")) + "--no-status" + "-0"))) (when extra-ignores (setq args (nconc args (mapcan @@ -618,17 +628,17 @@ backend implementation of `project-external-roots'.") (insert-file-contents ".gitmodules") (let (res) (goto-char (point-min)) - (while (re-search-forward "path *= *\\(.+\\)" nil t) + (while (re-search-forward "^[ \t]*path *= *\\(.+\\)" nil t) (push (match-string 1) res)) (nreverse res))) (file-missing nil))) (cl-defmethod project-ignores ((project (head vc)) dir) - (let* ((root (cdr project)) + (let* ((root (nth 2 project)) backend) (append (when (file-equal-p dir root) - (setq backend (vc-responsible-backend root)) + (setq backend (cadr project)) (delq nil (mapcar @@ -805,7 +815,6 @@ The following commands are available: (define-key tab-prefix-map "p" #'project-other-tab-command)) (declare-function grep-read-files "grep") -(declare-function xref--show-xrefs "xref") (declare-function xref--find-ignores-arguments "xref") ;;;###autoload @@ -831,7 +840,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (project--files-in-directory dir nil (grep-read-files regexp)))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -859,7 +868,7 @@ pattern to search for." (project-files pr (cons (project-root pr) (project-external-roots pr))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -890,8 +899,12 @@ interactively, include all files under the project root, except for VCS directories listed in `vc-directory-exclusion-list'." (interactive "P") (let* ((pr (project-current t)) - (dirs (list (project-root pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) + (root (project-root pr)) + (dirs (list root))) + (project-find-file-in + (or (thing-at-point 'filename) + (and buffer-file-name (file-relative-name buffer-file-name root))) + dirs pr include-all))) ;;;###autoload (defun project-or-external-find-file (&optional include-all) @@ -982,7 +995,7 @@ directories listed in `vc-directory-exclusion-list'." (project-files project dirs))) (completion-ignore-case read-file-name-completion-ignore-case) (file (funcall project-read-file-name-function - "Find file" all-files nil nil + "Find file" all-files nil 'file-name-history suggested-filename))) (if (string= file "") (user-error "You didn't specify the file") @@ -1019,7 +1032,7 @@ directories listed in `vc-directory-exclusion-list'." "Dired" ;; Some completion UIs show duplicates. (delete-dups all-dirs) - nil nil))) + nil 'file-name-history))) (dired dir))) ;;;###autoload @@ -1034,6 +1047,8 @@ directories listed in `vc-directory-exclusion-list'." (interactive) (vc-dir (project-root (project-current t)))) +(declare-function comint-check-proc "comint") + ;;;###autoload (defun project-shell () "Start an inferior shell in the current project's root directory. @@ -1042,11 +1057,14 @@ switch to it. Otherwise, create a new shell buffer. With \\[universal-argument] prefix arg, create a new inferior shell buffer even if one already exists." (interactive) + (require 'comint) (let* ((default-directory (project-root (project-current t))) (default-project-shell-name (project-prefixed-buffer-name "shell")) (shell-buffer (get-buffer default-project-shell-name))) (if (and shell-buffer (not current-prefix-arg)) - (pop-to-buffer shell-buffer display-comint-buffer-action) + (if (comint-check-proc shell-buffer) + (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action)) + (shell shell-buffer)) (shell (generate-new-buffer-name default-project-shell-name))))) ;;;###autoload @@ -1062,7 +1080,7 @@ if one already exists." (eshell-buffer-name (project-prefixed-buffer-name "eshell")) (eshell-buffer (get-buffer eshell-buffer-name))) (if (and eshell-buffer (not current-prefix-arg)) - (pop-to-buffer eshell-buffer display-comint-buffer-action) + (pop-to-buffer eshell-buffer (bound-and-true-p display-comint-buffer-action)) (eshell t)))) ;;;###autoload @@ -1098,14 +1116,24 @@ command \\[fileloop-continue]." (defun project-query-replace-regexp (from to) "Query-replace REGEXP in all the files of the project. Stops when a match is found and prompts for whether to replace it. +At that prompt, the user must type a character saying what to do +with the match. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. If you exit the `query-replace', you can later continue the `query-replace' loop using the command \\[fileloop-continue]." (interactive - (pcase-let ((`(,from ,to) - (query-replace-read-args "Query replace (regexp)" t t))) - (list from to))) + (let ((query-replace-read-from-regexp-default 'find-tag-default-as-regexp)) + (pcase-let ((`(,from ,to) + (query-replace-read-args "Query replace (regexp)" t t))) + (list from to)))) (fileloop-initialize-replace - from to (project-files (project-current t)) 'default) + from to + ;; XXX: Filter out Git submodules, which are not regular files. + ;; `project-files' can return those, which is arguably suboptimal, + ;; but removing them eagerly has performance cost. + (cl-delete-if-not #'file-regular-p (project-files (project-current t))) + 'default) (fileloop-continue)) (defvar compilation-read-command) @@ -1141,6 +1169,29 @@ If non-nil, it overrides `compilation-buffer-name-function' for compilation-buffer-name-function))) (call-interactively #'compile))) +(defcustom project-ignore-buffer-conditions nil + "List of conditions to filter the buffers to be switched to. +If any of these conditions are satisfied for a buffer in the +current project, `project-switch-to-buffer', +`project-display-buffer' and `project-display-buffer-other-frame' +ignore it. +See the doc string of `project-kill-buffer-conditions' for the +general form of conditions." + :type '(repeat (choice regexp function symbol + (cons :tag "Major mode" + (const major-mode) symbol) + (cons :tag "Derived mode" + (const derived-mode) symbol) + (cons :tag "Negation" + (const not) sexp) + (cons :tag "Conjunction" + (const and) sexp) + (cons :tag "Disjunction" + (const or) sexp))) + :version "29.1" + :group 'project + :package-version '(project . "0.8.2")) + (defun project--read-project-buffer () (let* ((pr (project-current t)) (current-buffer (current-buffer)) @@ -1150,7 +1201,10 @@ If non-nil, it overrides `compilation-buffer-name-function' for (predicate (lambda (buffer) ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist. - (memq (cdr buffer) buffers)))) + (and (memq (cdr buffer) buffers) + (not + (project--buffer-check + (cdr buffer) project-ignore-buffer-conditions)))))) (read-buffer "Switch to buffer: " (when (funcall predicate (cons other-name other-buffer)) @@ -1217,10 +1271,9 @@ Each condition is either: - a cons-cell, where the car describes how to interpret the cdr. The car can be one of the following: * `major-mode': the buffer is killed if the buffer's major - mode is eq to the cons-cell's cdr + mode is eq to the cons-cell's cdr. * `derived-mode': the buffer is killed if the buffer's major - mode is derived from the major mode denoted by the cons-cell's - cdr + mode is derived from the major mode in the cons-cell's cdr. * `not': the cdr is interpreted as a negation of a condition. * `and': the cdr is a list of recursive conditions, that all have to be met. @@ -1268,16 +1321,17 @@ Used by `project-kill-buffers'." (push buf bufs))) (nreverse bufs))) -(defun project--kill-buffer-check (buf conditions) +(defun project--buffer-check (buf conditions) "Check if buffer BUF matches any element of the list CONDITIONS. -See `project-kill-buffer-conditions' for more details on the form -of CONDITIONS." - (catch 'kill +See `project-kill-buffer-conditions' or +`project-ignore-buffer-conditions' for more details on the +form of CONDITIONS." + (catch 'match (dolist (c conditions) (when (cond ((stringp c) (string-match-p c (buffer-name buf))) - ((symbolp c) + ((functionp c) (funcall c buf)) ((eq (car-safe c) 'major-mode) (eq (buffer-local-value 'major-mode buf) @@ -1287,15 +1341,15 @@ of CONDITIONS." (buffer-local-value 'major-mode buf) (cdr c))) ((eq (car-safe c) 'not) - (not (project--kill-buffer-check buf (cdr c)))) + (not (project--buffer-check buf (cdr c)))) ((eq (car-safe c) 'or) - (project--kill-buffer-check buf (cdr c))) + (project--buffer-check buf (cdr c))) ((eq (car-safe c) 'and) (seq-every-p - (apply-partially #'project--kill-buffer-check + (apply-partially #'project--buffer-check buf) (mapcar #'list (cdr c))))) - (throw 'kill t))))) + (throw 'match t))))) (defun project--buffers-to-kill (pr) "Return list of buffers in project PR to kill. @@ -1303,7 +1357,7 @@ What buffers should or should not be killed is described in `project-kill-buffer-conditions'." (let (bufs) (dolist (buf (project-buffers pr)) - (when (project--kill-buffer-check buf project-kill-buffer-conditions) + (when (project--buffer-check buf project-kill-buffer-conditions) (push buf bufs))) bufs)) @@ -1316,7 +1370,9 @@ identical. Only the buffers that match a condition in `project-kill-buffer-conditions' will be killed. If NO-CONFIRM is non-nil, the command will not ask the user for confirmation. NO-CONFIRM is always nil when the command is invoked -interactively." +interactively. + +Also see the `project-kill-buffers-display-buffer-list' variable." (interactive) (let* ((pr (project-current t)) (bufs (project--buffers-to-kill pr)) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 8382c4bd099..5aba95d4c79 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -742,14 +742,6 @@ Relevant only when `prolog-imenu-flag' is non-nil." :group 'prolog-other :type 'boolean) -(defcustom prolog-char-quote-workaround nil - "If non-nil, declare 0 as a quote character to handle 0'<char>. -This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." - :version "24.1" - :group 'prolog-other - :type 'boolean) -(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") - ;;------------------------------------------------------------------- ;; Internal variables @@ -1303,7 +1295,7 @@ To find out what version of Prolog mode you are running, enter (t t))) ;; This statement was missing in Emacs 24.1, 24.2, 24.3. -(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") +(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") ; "24.4" ; for grep ;;;###autoload (defun run-prolog (arg) "Run an inferior Prolog process, input and output via buffer *prolog*. @@ -1355,8 +1347,6 @@ the variable `prolog-prompt-regexp'." (error "This Prolog system has defined no interpreter")) (unless (comint-check-proc "*prolog*") (with-current-buffer (get-buffer-create "*prolog*") - (prolog-inferior-mode) - ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier, ;; which assumes it is running under Emacs if either INFERIOR=yes or ;; if EMACS is set to a nonempty value. The EMACS setting is @@ -1369,6 +1359,7 @@ the variable `prolog-prompt-regexp'." (cons "INFERIOR=yes" process-environment)))) (apply 'make-comint-in-buffer "prolog" (current-buffer) pname nil pswitches)) + (prolog-inferior-mode) (unless prolog-system ;; Setup auto-detection. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index edd3139a7aa..1c99937c4b9 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -92,7 +92,7 @@ ;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7. ;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To ;; avoid this, the `python-shell-unbuffered' defaults to non-nil and -;; controls whether `python-shell-calculate-process-environment' +;; controls whether `python-shell--calculate-process-environment' ;; should set the "PYTHONUNBUFFERED" environment variable on startup: ;; See URL `https://docs.python.org/3/using/cmdline.html#cmdoption-u'. @@ -149,7 +149,7 @@ ;; (setq python-shell-process-environment ;; (list ;; (format "PATH=%s" (mapconcat -;; 'identity +;; #'identity ;; (reverse ;; (cons (getenv "PATH") ;; '("/path/to/env/bin/"))) @@ -245,10 +245,9 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) -(require 'tramp-sh) +(eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings -(defvar view-return-to-alist) (defvar compilation-error-regexp-alist) (defvar outline-heading-end-regexp) @@ -273,39 +272,39 @@ (defvar python-mode-map (let ((map (make-sparse-keymap))) ;; Movement - (define-key map [remap backward-sentence] 'python-nav-backward-block) - (define-key map [remap forward-sentence] 'python-nav-forward-block) - (define-key map [remap backward-up-list] 'python-nav-backward-up-list) - (define-key map [remap mark-defun] 'python-mark-defun) - (define-key map "\C-c\C-j" 'imenu) + (define-key map [remap backward-sentence] #'python-nav-backward-block) + (define-key map [remap forward-sentence] #'python-nav-forward-block) + (define-key map [remap backward-up-list] #'python-nav-backward-up-list) + (define-key map [remap mark-defun] #'python-mark-defun) + (define-key map "\C-c\C-j" #'imenu) ;; Indent specific - (define-key map "\177" 'python-indent-dedent-line-backspace) - (define-key map (kbd "<backtab>") 'python-indent-dedent-line) - (define-key map "\C-c<" 'python-indent-shift-left) - (define-key map "\C-c>" 'python-indent-shift-right) + (define-key map "\177" #'python-indent-dedent-line-backspace) + (define-key map (kbd "<backtab>") #'python-indent-dedent-line) + (define-key map "\C-c<" #'python-indent-shift-left) + (define-key map "\C-c>" #'python-indent-shift-right) ;; Skeletons - (define-key map "\C-c\C-tc" 'python-skeleton-class) - (define-key map "\C-c\C-td" 'python-skeleton-def) - (define-key map "\C-c\C-tf" 'python-skeleton-for) - (define-key map "\C-c\C-ti" 'python-skeleton-if) - (define-key map "\C-c\C-tm" 'python-skeleton-import) - (define-key map "\C-c\C-tt" 'python-skeleton-try) - (define-key map "\C-c\C-tw" 'python-skeleton-while) + (define-key map "\C-c\C-tc" #'python-skeleton-class) + (define-key map "\C-c\C-td" #'python-skeleton-def) + (define-key map "\C-c\C-tf" #'python-skeleton-for) + (define-key map "\C-c\C-ti" #'python-skeleton-if) + (define-key map "\C-c\C-tm" #'python-skeleton-import) + (define-key map "\C-c\C-tt" #'python-skeleton-try) + (define-key map "\C-c\C-tw" #'python-skeleton-while) ;; Shell interaction - (define-key map "\C-c\C-p" 'run-python) - (define-key map "\C-c\C-s" 'python-shell-send-string) - (define-key map "\C-c\C-e" 'python-shell-send-statement) - (define-key map "\C-c\C-r" 'python-shell-send-region) - (define-key map "\C-\M-x" 'python-shell-send-defun) - (define-key map "\C-c\C-c" 'python-shell-send-buffer) - (define-key map "\C-c\C-l" 'python-shell-send-file) - (define-key map "\C-c\C-z" 'python-shell-switch-to-shell) + (define-key map "\C-c\C-p" #'run-python) + (define-key map "\C-c\C-s" #'python-shell-send-string) + (define-key map "\C-c\C-e" #'python-shell-send-statement) + (define-key map "\C-c\C-r" #'python-shell-send-region) + (define-key map "\C-\M-x" #'python-shell-send-defun) + (define-key map "\C-c\C-c" #'python-shell-send-buffer) + (define-key map "\C-c\C-l" #'python-shell-send-file) + (define-key map "\C-c\C-z" #'python-shell-switch-to-shell) ;; Some util commands - (define-key map "\C-c\C-v" 'python-check) - (define-key map "\C-c\C-f" 'python-eldoc-at-point) - (define-key map "\C-c\C-d" 'python-describe-at-point) + (define-key map "\C-c\C-v" #'python-check) + (define-key map "\C-c\C-f" #'python-eldoc-at-point) + (define-key map "\C-c\C-d" #'python-describe-at-point) ;; Utilities - (substitute-key-definition 'complete-symbol 'completion-at-point + (substitute-key-definition #'complete-symbol #'completion-at-point map global-map) (easy-menu-define python-menu map "Python Mode menu" '("Python" @@ -359,9 +358,12 @@ (defmacro python-rx (&rest regexps) "Python mode specialized rx macro. This variant of `rx' supports common Python named REGEXPS." - `(rx-let ((block-start (seq symbol-start + `(rx-let ((sp-bsnl (or space (and ?\\ ?\n))) + (block-start (seq symbol-start (or "def" "class" "if" "elif" "else" "try" "except" "finally" "for" "while" "with" + ;; Python 3.10+ PEP634 + "match" "case" ;; Python 3.5+ PEP492 (and "async" (+ space) (or "def" "for" "with"))) @@ -394,7 +396,7 @@ This variant of `rx' supports common Python named REGEXPS." (open-paren (or "{" "[" "(")) (close-paren (or "}" "]" ")")) (simple-operator (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)) - (not-simple-operator (not simple-operator)) + (not-simple-operator (not (or simple-operator ?\n))) (operator (or "==" ">=" "is" "not" "**" "//" "<<" ">>" "<=" "!=" "+" "-" "/" "&" "^" "~" "|" "*" "<" ">" @@ -538,9 +540,9 @@ the {...} holes that appear within f-strings." (setq ppss (syntax-ppss)))))) (defvar python-font-lock-keywords-level-1 - `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) + `((,(python-rx symbol-start "def" (1+ space) (group symbol-name)) (1 font-lock-function-name-face)) - (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) + (,(python-rx symbol-start "class" (1+ space) (group symbol-name)) (1 font-lock-type-face))) "Font lock keywords to use in `python-mode' for level 1 decoration. @@ -563,6 +565,8 @@ class declarations.") ;; Python 3.5+ PEP492 (and "async" (+ space) (or "def" "for" "with")) "await" + ;; Python 3.10+ + "match" "case" ;; Extra: "self") symbol-end) @@ -601,15 +605,18 @@ builtins.") (defun python-font-lock-assignment-matcher (regexp) "Font lock matcher for assignments based on REGEXP. -Return nil if REGEXP matched within a `paren' context (to avoid, -e.g., default values for arguments or passing arguments by name -being treated as assignments) or is followed by an '=' sign (to -avoid '==' being treated as an assignment." +Search for next occurrence if REGEXP matched within a `paren' +context (to avoid, e.g., default values for arguments or passing +arguments by name being treated as assignments) or is followed by +an '=' sign (to avoid '==' being treated as an assignment. Set +point to the position one character before the end of the +occurrence found so that subsequent searches can detect the '=' +sign in chained assignment." (lambda (limit) - (let ((res (re-search-forward regexp limit t))) - (unless (or (python-syntax-context 'paren) - (equal (char-after (point)) ?=)) - res)))) + (cl-loop while (re-search-forward regexp limit t) + unless (or (python-syntax-context 'paren) + (equal (char-after) ?=)) + return (progn (backward-char) t)))) (defvar python-font-lock-keywords-maximum-decoration `((python--font-lock-f-strings) @@ -671,7 +678,7 @@ avoid '==' being treated as an assignment." ;; and variants thereof ;; the cases ;; (a) = 5 - ;; [a] = 5 + ;; [a] = 5, ;; [*a] = 5, 6 ;; are handled separately below (,(python-font-lock-assignment-matcher @@ -701,10 +708,11 @@ avoid '==' being treated as an assignment." (1 font-lock-variable-name-face)) ;; special cases ;; (a) = 5 - ;; [a] = 5 + ;; [a] = 5, ;; [*a] = 5, 6 (,(python-font-lock-assignment-matcher - (python-rx (or "[" "(") (* space) + (python-rx (or line-start ?\; ?=) (* space) + (or "[" "(") (* space) grouped-assignment-target (* space) (or ")" "]") (* space) assignment-operator)) @@ -825,7 +833,6 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-offset 4 "Default indentation offset for Python." - :group 'python :type 'integer :safe 'integerp) @@ -835,21 +842,18 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-guess-indent-offset t "Non-nil tells Python mode to guess `python-indent-offset' value." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-indent-guess-indent-offset-verbose t "Non-nil means to emit a warning when indentation guessing fails." :version "25.1" :type 'boolean - :group 'python :safe' booleanp) (defcustom python-indent-trigger-commands '(indent-for-tab-command yas-expand yas/expand) "Commands that might trigger a `python-indent-line' call." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-indent-def-block-scale 2 "Multiplier applied to indentation inside multi-line def blocks." @@ -1298,7 +1302,7 @@ Called from a program, START and END specify the region to indent." ;; Don't mess with strings, unless it's the ;; enclosing set of quotes or a docstring. (or (not (python-syntax-context 'string)) - (eq + (equal (syntax-after (+ (1- (point)) (current-indentation) @@ -1435,7 +1439,7 @@ marks the next defun after the ones already marked." function)) (defvar python-nav-beginning-of-defun-regexp - (python-rx line-start (* space) defun (+ space) (group symbol-name)) + (python-rx line-start (* space) defun (+ sp-bsnl) (group symbol-name)) "Regexp matching class or function definition. The name of the defun should be grouped so it can be retrieved via `match-string'.") @@ -1450,26 +1454,34 @@ With positive ARG search backwards, else search forwards." (line-beg-pos (line-beginning-position)) (line-content-start (+ line-beg-pos (current-indentation))) (pos (point-marker)) + (min-indentation (+ (current-indentation) + (if (python-info-looking-at-beginning-of-defun) + python-indent-offset 0))) (body-indentation (and (> arg 0) (save-excursion (while (and - (not (python-info-looking-at-beginning-of-defun)) + (or (not (python-info-looking-at-beginning-of-defun)) + (>= (current-indentation) min-indentation)) + (setq min-indentation + (min min-indentation (current-indentation))) (python-nav-backward-block))) (or (and (python-info-looking-at-beginning-of-defun) (+ (current-indentation) python-indent-offset)) 0)))) (found (progn - (when (and (python-info-looking-at-beginning-of-defun) + (when (and (python-info-looking-at-beginning-of-defun nil t) (or (< arg 0) ;; If looking at beginning of defun, and if ;; pos is > line-content-start, ensure a ;; backward re search match this defun by ;; going to end of line before calling ;; re-search-fn bug#40563 - (and (> arg 0) (> pos line-content-start)))) - (end-of-line 1)) + (and (> arg 0) + (or (python-info-continuation-line-p) + (> pos line-content-start))))) + (python-nav-end-of-statement)) (while (and (funcall re-search-fn python-nav-beginning-of-defun-regexp nil t) @@ -1479,14 +1491,18 @@ With positive ARG search backwards, else search forwards." (and (> arg 0) (not (= (current-indentation) 0)) (>= (current-indentation) body-indentation))))) - (and (python-info-looking-at-beginning-of-defun) + (and (python-info-looking-at-beginning-of-defun nil t) (or (not (= (line-number-at-pos pos) (line-number-at-pos))) (and (>= (point) line-beg-pos) (<= (point) line-content-start) (> pos line-content-start))))))) (if found - (or (beginning-of-line 1) t) + (progn + (when (< arg 0) + (python-nav-beginning-of-statement)) + (beginning-of-line 1) + t) (and (goto-char pos) nil)))) (defun python-nav-beginning-of-defun (&optional arg) @@ -1625,28 +1641,29 @@ of the statement." (while (and (or noend (goto-char (line-end-position))) (not (eobp)) (cond ((setq string-start (python-syntax-context 'string)) - ;; The assertion can only fail if syntax table + ;; The condition can be nil if syntax table ;; text properties and the `syntax-ppss' cache ;; are somehow out of whack. This has been ;; observed when using `syntax-ppss' during ;; narrowing. - (cl-assert (>= string-start last-string-end) - :show-args - "\ -Overlapping strings detected (start=%d, last-end=%d)") - (goto-char string-start) - (if (python-syntax-context 'paren) - ;; Ended up inside a paren, roll again. - (python-nav-end-of-statement t) - ;; This is not inside a paren, move to the - ;; end of this string. - (goto-char (+ (point) - (python-syntax-count-quotes - (char-after (point)) (point)))) - (setq last-string-end - (or (re-search-forward - (rx (syntax string-delimiter)) nil t) - (goto-char (point-max)))))) + ;; It can also fail in cases where the buffer is in + ;; the process of being modified, e.g. when creating + ;; a string with `electric-pair-mode' disabled such + ;; that there can be an unmatched single quote + (when (>= string-start last-string-end) + (goto-char string-start) + (if (python-syntax-context 'paren) + ;; Ended up inside a paren, roll again. + (python-nav-end-of-statement t) + ;; This is not inside a paren, move to the + ;; end of this string. + (goto-char (+ (point) + (python-syntax-count-quotes + (char-after (point)) (point)))) + (setq last-string-end + (or (re-search-forward + (rx (syntax string-delimiter)) nil t) + (goto-char (point-max))))))) ((python-syntax-context 'paren) ;; The statement won't end before we've escaped ;; at least one level of parenthesis. @@ -1715,7 +1732,10 @@ backward to previous statement." (while (and (forward-line 1) (not (eobp)) (or (and (> (current-indentation) block-indentation) - (or (python-nav-end-of-statement) t)) + (let ((start (point))) + (python-nav-end-of-statement) + ;; must move forward otherwise infinite loop + (> (point) start))) (python-info-current-line-comment-p) (python-info-current-line-empty-p)))) (python-util-forward-comment -1) @@ -2031,7 +2051,6 @@ position, else returns nil." (defcustom python-shell-buffer-name "Python" "Default buffer name for Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter @@ -2045,19 +2064,16 @@ Some Python interpreters also require changes to `python-shell-interpreter' to \"ipython3\" requires setting `python-shell-interpreter-args' to \"--simple-prompt\"." :version "28.1" - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-internal-buffer-name "Python Internal" "Default buffer name for the Internal Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter-args "-i" "Default arguments for the Python interpreter." - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-interpreter-interactive-arg "-i" "Interpreter argument to force it to run interactively." @@ -2122,7 +2138,6 @@ It should not contain a caret (^) at the beginning." "Should syntax highlighting be enabled in the Python shell buffer? Restart the Python shell after changing this variable for it to take effect." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-unbuffered t @@ -2130,7 +2145,6 @@ Restart the Python shell after changing this variable for it to take effect." When non-nil, this may prevent delayed and missing output in the Python shell. See commentary for details." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-process-environment nil @@ -2140,8 +2154,7 @@ When this variable is non-nil, values are exported into the process environment before starting it. Any variables already present in the current environment are superseded by variables set here." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-extra-pythonpaths nil "List of extra pythonpaths for Python shell. @@ -2150,8 +2163,7 @@ the PYTHONPATH before starting processes. Any values present here that already exists in PYTHONPATH are moved to the beginning of the list so that they are prioritized when looking for modules." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-exec-path nil "List of paths for searching executables. @@ -2159,8 +2171,7 @@ When this variable is non-nil, values added at the beginning of the PATH before starting processes. Any values present here that already exists in PATH are moved to the beginning of the list so that they are prioritized when looking for executables." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-remote-exec-path nil "List of paths to be ensured remotely for searching executables. @@ -2171,8 +2182,7 @@ here. Normally you won't use this variable directly unless you plan to ensure a particular set of paths to all Python shell executed through tramp connections." :version "25.1" - :type '(repeat string) - :group 'python) + :type '(repeat string)) (define-obsolete-variable-alias 'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1") @@ -2182,13 +2192,11 @@ executed through tramp connections." This variable, when set to a string, makes the environment to be modified such that shells are started within the specified virtualenv." - :type '(choice (const nil) directory) - :group 'python) + :type '(choice (const nil) directory)) (defcustom python-shell-setup-codes nil "List of code run by `python-shell-send-setup-code'." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-shell-compilation-regexp-alist `((,(rx line-start (1+ (any " \t")) "File \"" @@ -2202,8 +2210,7 @@ virtualenv." "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()") 1 2)) "`compilation-error-regexp-alist' for inferior Python." - :type '(alist regexp) - :group 'python) + :type '(alist regexp)) (defvar python-shell-output-filter-in-progress nil) (defvar python-shell-output-filter-buffer nil) @@ -2221,33 +2228,34 @@ virtualenv." (or (getenv "PYTHONPATH") "") path-separator 'omit))) (python-shell--add-to-path-with-priority pythonpath python-shell-extra-pythonpaths) - (mapconcat 'identity pythonpath path-separator))) + (mapconcat #'identity pythonpath path-separator))) (defun python-shell-calculate-process-environment () - "Calculate `process-environment' or `tramp-remote-process-environment'. + (declare (obsolete python-shell--calculate-process-environment "29.1")) + (defvar tramp-remote-process-environment) + (let* ((remote-p (file-remote-p default-directory))) + (append (python-shell--calculate-process-environment) + (if remote-p + tramp-remote-process-environment + process-environment)))) + +(defun python-shell--calculate-process-environment () + "Return a list of entries to add to the `process-environment'. Prepends `python-shell-process-environment', sets extra pythonpaths from `python-shell-extra-pythonpaths' and sets a few -virtualenv related vars. If `default-directory' points to a -remote host, the returned value is intended for -`tramp-remote-process-environment'." - (let* ((remote-p (file-remote-p default-directory)) - (process-environment (if remote-p - tramp-remote-process-environment - process-environment)) - (virtualenv (when python-shell-virtualenv-root - (directory-file-name python-shell-virtualenv-root)))) - (dolist (env python-shell-process-environment) - (pcase-let ((`(,key ,value) (split-string env "="))) - (setenv key value))) +virtualenv related vars." + (let* ((virtualenv (when python-shell-virtualenv-root + (directory-file-name python-shell-virtualenv-root))) + (res python-shell-process-environment)) (when python-shell-unbuffered - (setenv "PYTHONUNBUFFERED" "1")) + (push "PYTHONUNBUFFERED=1" res)) (when python-shell-extra-pythonpaths - (setenv "PYTHONPATH" (python-shell-calculate-pythonpath))) + (push (concat "PYTHONPATH=" (python-shell-calculate-pythonpath)) res)) (if (not virtualenv) - process-environment - (setenv "PYTHONHOME" nil) - (setenv "VIRTUAL_ENV" virtualenv)) - process-environment)) + nil + (push "PYTHONHOME" res) + (push (concat "VIRTUAL_ENV=" virtualenv) res)) + res)) (defun python-shell-calculate-exec-path () "Calculate `exec-path'. @@ -2275,14 +2283,26 @@ of `exec-path'." (defun python-shell-tramp-refresh-remote-path (vec paths) "Update VEC's remote-path giving PATHS priority." + (cl-assert (featurep 'tramp)) + (declare-function tramp-set-remote-path "tramp-sh") + (declare-function tramp-set-connection-property "tramp-cache") + (declare-function tramp-get-connection-property "tramp-cache") (let ((remote-path (tramp-get-connection-property vec "remote-path" nil))) (when remote-path + ;; FIXME: This part of the Tramp code still knows about Python! (python-shell--add-to-path-with-priority remote-path paths) (tramp-set-connection-property vec "remote-path" remote-path) (tramp-set-remote-path vec)))) + (defun python-shell-tramp-refresh-process-environment (vec env) "Update VEC's process environment with ENV." + (cl-assert (featurep 'tramp)) + (defvar tramp-end-of-heredoc) + (defvar tramp-end-of-output) + ;; Do we even know that `tramp-sh' is loaded at this point? + ;; What about files accessed via FTP, sudo, ...? + (declare-function tramp-send-command "tramp-sh") ;; Stolen from `tramp-open-connection-setup-interactive-shell'. (let ((env (append (when (fboundp 'tramp-get-remote-locale) ;; Emacs<24.4 compat. @@ -2295,7 +2315,7 @@ of `exec-path'." unset vars item) (while env (setq item (split-string (car env) "=" 'omit)) - (setcdr item (mapconcat 'identity (cdr item) "=")) + (setcdr item (mapconcat #'identity (cdr item) "=")) (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) (push (format "%s %s" (car item) (cdr item)) vars) (push (car item) unset)) @@ -2305,12 +2325,12 @@ of `exec-path'." vec (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" tramp-end-of-heredoc - (mapconcat 'identity vars "\n") + (mapconcat #'identity vars "\n") tramp-end-of-heredoc) t)) (when unset (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) + vec (format "unset %s" (mapconcat #'identity unset " ")) t)))) (defmacro python-shell-with-environment (&rest body) "Modify shell environment during execution of BODY. @@ -2319,41 +2339,49 @@ execution of body. If `default-directory' points to a remote machine then modifies `tramp-remote-process-environment' and `python-shell-remote-exec-path' instead." (declare (indent 0) (debug (body))) - (let ((vec (make-symbol "vec"))) - `(progn - (let* ((,vec - (when (file-remote-p default-directory) - (ignore-errors - (tramp-dissect-file-name default-directory 'noexpand)))) - (process-environment - (if ,vec - process-environment - (python-shell-calculate-process-environment))) - (exec-path - (if ,vec - exec-path - (python-shell-calculate-exec-path))) - (tramp-remote-process-environment - (if ,vec - (python-shell-calculate-process-environment) - tramp-remote-process-environment))) - (when (tramp-get-connection-process ,vec) - ;; For already existing connections, the new exec path must - ;; be re-set, otherwise it won't take effect. One example - ;; of such case is when remote dir-locals are read and - ;; *then* subprocesses are triggered within the same - ;; connection. - (python-shell-tramp-refresh-remote-path - ,vec (python-shell-calculate-exec-path)) - ;; The `tramp-remote-process-environment' variable is only - ;; effective when the started process is an interactive - ;; shell, otherwise (like in the case of processes started - ;; with `process-file') the environment is not changed. - ;; This makes environment modifications effective - ;; unconditionally. - (python-shell-tramp-refresh-process-environment - ,vec tramp-remote-process-environment)) - ,(macroexp-progn body))))) + `(python-shell--with-environment + (python-shell--calculate-process-environment) + (lambda () ,@body))) + +(defun python-shell--with-environment (extraenv bodyfun) + ;; FIXME: This is where the generic code delegates to Tramp. + (let* ((vec + (and (file-remote-p default-directory) + (fboundp 'tramp-dissect-file-name) + (ignore-errors + (tramp-dissect-file-name default-directory 'noexpand))))) + (if vec + (python-shell--tramp-with-environment vec extraenv bodyfun) + (let ((process-environment + (append extraenv process-environment)) + (exec-path + ;; FIXME: This is still Python-specific. + (python-shell-calculate-exec-path))) + (funcall bodyfun))))) + +(defun python-shell--tramp-with-environment (vec extraenv bodyfun) + (defvar tramp-remote-process-environment) + (declare-function tramp-get-connection-process "tramp" (vec)) + (let* ((tramp-remote-process-environment + (append extraenv tramp-remote-process-environment))) + (when (tramp-get-connection-process vec) + ;; For already existing connections, the new exec path must + ;; be re-set, otherwise it won't take effect. One example + ;; of such case is when remote dir-locals are read and + ;; *then* subprocesses are triggered within the same + ;; connection. + (python-shell-tramp-refresh-remote-path + ;; FIXME: This is still Python-specific. + vec (python-shell-calculate-exec-path)) + ;; The `tramp-remote-process-environment' variable is only + ;; effective when the started process is an interactive + ;; shell, otherwise (like in the case of processes started + ;; with `process-file') the environment is not changed. + ;; This makes environment modifications effective + ;; unconditionally. + (python-shell-tramp-refresh-process-environment + vec tramp-remote-process-environment)) + (funcall bodyfun))) (defvar python-shell--prompt-calculated-input-regexp nil "Calculated input prompt regexp for inferior python shell. @@ -2636,12 +2664,13 @@ banner and the initial prompt are received separately." (define-obsolete-function-alias 'python-comint-output-filter-function - 'ansi-color-filter-apply + #'ansi-color-filter-apply "25.1") (defun python-comint-postoutput-scroll-to-bottom (output) "Faster version of `comint-postoutput-scroll-to-bottom'. Avoids `recenter' calls until OUTPUT is completely sent." + (declare (obsolete nil "29.1")) ; Not used. (when (and (not (string= "" output)) (python-shell-comint-end-of-output-p (ansi-color-filter-apply output))) @@ -2821,8 +2850,7 @@ current process to not hang while waiting. This is useful to safely attach setup code for long-running processes that eventually provide a shell." :version "25.1" - :type 'hook - :group 'python) + :type 'hook) (defconst python-shell-eval-setup-code "\ @@ -2948,15 +2976,15 @@ variable. (setq-local comint-output-filter-functions '(ansi-color-process-output python-shell-comint-watch-for-first-prompt-output-filter - python-comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)) (setq-local comint-highlight-input nil) (setq-local compilation-error-regexp-alist python-shell-compilation-regexp-alist) + (setq-local scroll-conservatively 1) (add-hook 'completion-at-point-functions #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" - 'python-shell-completion-complete-or-indent) + #'python-shell-completion-complete-or-indent) (make-local-variable 'python-shell-internal-last-output) (when python-shell-font-lock-enable (python-shell-font-lock-turn-on)) @@ -2982,7 +3010,8 @@ killed." (let* ((cmdlist (split-string-and-unquote cmd)) (interpreter (car cmdlist)) (args (cdr cmdlist)) - (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name + (buffer (apply #'make-comint-in-buffer proc-name + proc-buffer-name interpreter nil args)) (python-shell--parent-buffer (current-buffer)) (process (get-buffer-process buffer)) @@ -3080,7 +3109,8 @@ of `error' with a user-friendly message." (or (python-shell-get-process) (if interactivep (user-error - "Start a Python process first with `M-x run-python' or `%s'" + (substitute-command-keys + "Start a Python process first with \\`M-x run-python' or `%s'") ;; Get the binding. (key-description (where-is-internal @@ -3131,7 +3161,7 @@ there for compatibility with CEDET.") (run-python-internal)))) (define-obsolete-function-alias - 'python-proc 'python-shell-internal-get-or-create-process "24.3") + 'python-proc #'python-shell-internal-get-or-create-process "24.3") (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory @@ -3216,11 +3246,13 @@ detecting a prompt at the end of the buffer." (defun python-shell-send-string-no-output (string &optional process) "Send STRING to PROCESS and inhibit output. Return the output." - (let ((process (or process (python-shell-get-process-or-error))) - (comint-preoutput-filter-functions - '(python-shell-output-filter)) - (python-shell-output-filter-in-progress t) - (inhibit-quit t)) + (or process (setq process (python-shell-get-process-or-error))) + (cl-letf (((process-filter process) + (lambda (_proc str) + (with-current-buffer (process-buffer process) + (python-shell-output-filter str)))) + (python-shell-output-filter-in-progress t) + (inhibit-quit t)) (or (with-local-quit (python-shell-send-string string process) @@ -3248,10 +3280,10 @@ Returns the output. See `python-shell-send-string-no-output'." (python-shell-internal-get-or-create-process)))) (define-obsolete-function-alias - 'python-send-receive 'python-shell-internal-send-string "24.3") + 'python-send-receive #'python-shell-internal-send-string "24.3") (define-obsolete-function-alias - 'python-send-string 'python-shell-internal-send-string "24.3") + 'python-send-string #'python-shell-internal-send-string "24.3") (defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. @@ -3286,22 +3318,25 @@ the python shell: (goto-char start) (python-util-forward-comment 1) (current-indentation)))) - (fillstr (and (not no-cookie) - (not starts-at-point-min-p) - (concat - (format "# -*- coding: %s -*-\n" encoding) - (make-string - ;; Subtract 2 because of the coding cookie. - (- (line-number-at-pos start) 2) ?\n))))) + (fillstr (cond (starts-at-point-min-p + nil) + ((not no-cookie) + (concat + (format "# -*- coding: %s -*-\n" encoding) + (make-string + ;; Subtract 2 because of the coding cookie. + (- (line-number-at-pos start) 2) ?\n))) + (t + (make-string (- (line-number-at-pos start) 1) ?\n))))) (with-temp-buffer (python-mode) (when fillstr (insert fillstr)) - (insert substring) - (goto-char (point-min)) (when (not toplevel-p) - (insert "if True:") + (forward-line -1) + (insert "if True:\n") (delete-region (point) (line-end-position))) + (insert substring) (when nomain (let* ((if-name-main-start-end (and nomain @@ -3547,8 +3582,7 @@ def __PYTHON_EL_get_completions(text): completer.print_mode = True return completions" "Code used to setup completion in inferior Python processes." - :type 'string - :group 'python) + :type 'string) (define-obsolete-variable-alias 'python-shell-completion-module-string-code @@ -3821,7 +3855,8 @@ With argument MSG show activation/deactivation message." ;; in use based on its args and uses `apply-partially' ;; to make it up for the 3 args case. (if (= (length - (help-function-arglist 'comint-redirect-filter)) 3) + (help-function-arglist 'comint-redirect-filter)) + 3) (set-process-filter process (apply-partially #'comint-redirect-filter original-filter-fn)) @@ -3930,7 +3965,7 @@ using that one instead of current buffer's process." (define-obsolete-function-alias 'python-shell-completion-complete-at-point - 'python-shell-completion-at-point + #'python-shell-completion-at-point "25.1") (defun python-shell-completion-complete-or-indent () @@ -3959,7 +3994,6 @@ considered over. The overlay arrow will be removed from the currently tracked buffer. Additionally, if `python-pdbtrack-kill-buffers' is non-nil, all files opened by pdbtracking will be killed." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-pdbtrack-stacktrace-info-regexp @@ -4168,7 +4202,7 @@ inferior Python process is updated properly." (define-obsolete-function-alias 'python-completion-complete-at-point - 'python-completion-at-point + #'python-completion-at-point "25.1") @@ -4178,29 +4212,25 @@ inferior Python process is updated properly." "Function to fill comments. This is the function used by `python-fill-paragraph' to fill comments." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-string-function 'python-fill-string "Function to fill strings. This is the function used by `python-fill-paragraph' to fill strings." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-decorator-function 'python-fill-decorator "Function to fill decorators. This is the function used by `python-fill-paragraph' to fill decorators." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-paren-function 'python-fill-paren "Function to fill parens. This is the function used by `python-fill-paragraph' to fill parens." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-docstring-style 'pep-257 "Style used to fill docstrings. @@ -4270,7 +4300,6 @@ value may result in one of the following docstring styles: (const :tag "PEP-257 with 2 newlines at end of string." pep-257) (const :tag "PEP-257 with 1 newline at end of string." pep-257-nn) (const :tag "Symmetric style." symmetric)) - :group 'python :safe (lambda (val) (memq val '(django onetwo pep-257 pep-257-nn symmetric nil)))) @@ -4429,7 +4458,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." This happens when pressing \"if<SPACE>\", for example, to prompt for the if condition." :type 'boolean - :group 'python :safe 'booleanp) (defvar python-skeleton-available '() @@ -4554,7 +4582,7 @@ The skeleton will be bound to python-skeleton-NAME." (defun python-skeleton-add-menu-items () "Add menu items to Python->Skeletons menu." - (let ((skeletons (sort python-skeleton-available 'string<))) + (let ((skeletons (sort python-skeleton-available #'string<))) (dolist (skeleton skeletons) (easy-menu-add-item nil '("Python" "Skeletons") @@ -4584,8 +4612,7 @@ def __FFAP_get_module_path(objstr): except: return ''" "Python code to get a module path." - :type 'string - :group 'python) + :type 'string) (defun python-ffap-module-path (module) "Function for `ffap-alist' to return path for MODULE." @@ -4613,14 +4640,12 @@ def __FFAP_get_module_path(objstr): (executable-find "epylint") "install pyflakes, pylint or something else") "Command used to check a Python file." - :type 'string - :group 'python) + :type 'string) (defcustom python-check-buffer-name "*Python check: %s*" "Buffer name used for check commands." - :type 'string - :group 'python) + :type 'string) (defvar python-check-custom-command nil "Internal use.") @@ -4687,8 +4712,7 @@ See `python-check-command' for the default." doc = '' return doc" "Python code to setup documentation retrieval." - :type 'string - :group 'python) + :type 'string) (defun python-eldoc--get-symbol-at-point () "Get the current symbol for eldoc. @@ -4735,14 +4759,13 @@ Set to nil by `python-eldoc-function' if (defcustom python-eldoc-function-timeout 1 "Timeout for `python-eldoc-function' in seconds." - :group 'python :type 'integer :version "25.1") (defcustom python-eldoc-function-timeout-permanent t - "Non-nil means that when `python-eldoc-function' times out -`python-eldoc-get-doc' will be set to nil." - :group 'python + "If non-nil, a timeout in Python-Eldoc will disable it permanently. +Python-Eldoc can be re-enabled manually by setting `python-eldoc-get-doc' +back to t in the affected buffer." :type 'boolean :version "25.1") @@ -4934,7 +4957,7 @@ To this: (\"decorator.wrapped_f\" . 393))" ;; Inspired by imenu--flatten-index-alist removed in revno 21853. (apply - 'nconc + #'nconc (mapcar (lambda (item) (let ((name (if prefix @@ -5017,7 +5040,7 @@ since it returns nil if point is not inside a defun." (and (= (current-indentation) 0) (throw 'exit t)))) (and names (concat (and type (format "%s " type)) - (mapconcat 'identity names "."))))))) + (mapconcat #'identity names "."))))))) (defun python-info-current-symbol (&optional replace-self) "Return current symbol using dotty syntax. @@ -5038,9 +5061,10 @@ parent defun name." (replace-regexp-in-string (python-rx line-start word-start "self" word-end ?.) (concat - (mapconcat 'identity + (mapconcat #'identity (butlast (split-string current-defun "\\.")) - ".") ".") + ".") + ".") name))))))) (defun python-info-statement-starts-block-p () @@ -5082,7 +5106,7 @@ parent defun name." (define-obsolete-function-alias 'python-info-closing-block - 'python-info-dedenter-opening-block-position "24.4") + #'python-info-dedenter-opening-block-position "24.4") (defun python-info-dedenter-opening-block-position () "Return the point of the closest block the current line closes. @@ -5127,7 +5151,8 @@ likely an invalid python file." (let ((indentation (current-indentation))) (when (and (not (memq indentation collected-indentations)) (or (not collected-indentations) - (< indentation (apply #'min collected-indentations))) + (< indentation + (apply #'min collected-indentations))) ;; There must be no line with indentation ;; smaller than `indentation' (except for ;; blank lines) between the found opening @@ -5155,7 +5180,7 @@ likely an invalid python file." (define-obsolete-function-alias 'python-info-closing-block-message - 'python-info-dedenter-opening-block-message "24.4") + #'python-info-dedenter-opening-block-message "24.4") (defun python-info-dedenter-opening-block-message () "Message the first line of the block the current statement closes." @@ -5280,10 +5305,15 @@ operator." (forward-line -1) (python-info-assignment-statement-p t)))) -(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss) - "Check if point is at `beginning-of-defun' using SYNTAX-PPSS." +(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss + check-statement) + "Check if point is at `beginning-of-defun' using SYNTAX-PPSS. +When CHECK-STATEMENT is non-nil, the current statement is checked +instead of the current physical line." (and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss)))) (save-excursion + (when check-statement + (python-nav-beginning-of-statement)) (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) @@ -5457,10 +5487,12 @@ allowed files." (let ((dir-name (file-name-as-directory dir))) (apply #'nconc (mapcar (lambda (file-name) - (let ((full-file-name (expand-file-name file-name dir-name))) + (let ((full-file-name + (expand-file-name file-name dir-name))) (when (and (not (member file-name '("." ".."))) - (funcall (or predicate #'identity) full-file-name)) + (funcall (or predicate #'identity) + full-file-name)) (list full-file-name)))) (directory-files dir-name))))) @@ -5528,7 +5560,6 @@ required arguments. Once launched it will receive the Python source to be checked as its standard input. To use `flake8' you would set this to (\"flake8\" \"-\")." :version "26.1" - :group 'python-flymake :type '(repeat string)) ;; The default regexp accommodates for older pyflakes, which did not @@ -5550,7 +5581,6 @@ If COLUMN or TYPE are nil or that index didn't match, that information is not present on the matched line and a default will be used." :version "26.1" - :group 'python-flymake :type '(list regexp (integer :tag "Line's index") (choice @@ -5575,7 +5605,6 @@ configuration could be: By default messages are considered errors." :version "26.1" - :group 'python-flymake :type '(alist :key-type (regexp) :value-type (symbol))) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 72631a6557f..87bb92908d1 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -70,7 +70,7 @@ "Regexp to match modifiers.") (defconst ruby-block-mid-keywords - '("then" "else" "elsif" "when" "rescue" "ensure") + '("then" "else" "elsif" "when" "in" "rescue" "ensure") "Keywords where the indentation gets shallower in middle of block statements.") (defconst ruby-block-mid-re @@ -325,6 +325,13 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." "Use `ruby-encoding-map' to set encoding magic comment if this is non-nil." :type 'boolean :group 'ruby) +(defcustom ruby-toggle-block-space-before-parameters t + "When non-nil, ensure space between the \"toggled\" curly and parameters. +This only affects the output of the command `ruby-toggle-block'." + :type 'boolean + :safe 'booleanp + :version "29.1") + ;;; SMIE support (require 'smie) @@ -362,7 +369,9 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (for-body (for-head ";" insts)) (for-head (id "in" exp)) (cases (exp "then" insts) - (cases "when" cases) (insts "else" insts)) + (cases "when" cases) + (cases "in" cases) + (insts "else" insts)) (expseq (exp) );;(expseq "," expseq) (hashvals (exp1 "=>" exp1) (hashvals "," hashvals)) (insts-rescue-insts (insts) @@ -373,7 +382,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (if-body (ielsei) (if-body "elsif" if-body))) '((nonassoc "in") (assoc ";") (right " @ ") (assoc ",") (right "=")) - '((assoc "when")) + '((assoc "when" "in")) '((assoc "elsif")) '((assoc "rescue" "ensure")) '((assoc ","))) @@ -499,7 +508,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ((member tok '("unless" "if" "while" "until")) (if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp)) tok "iuwu-mod")) - ((string-match-p "\\`|[*&]?\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char (- 1 (length tok))) (setq tok "|") (cond @@ -552,7 +561,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ((ruby-smie--closing-pipe-p) "closing-|") (t tok))) ((string-match-p "\\`[^|]+|\\'" tok) "closing-|") - ((string-match-p "\\`|[*&]\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char 1) (substring tok 1)) ((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n")) @@ -588,7 +597,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (cond ((smie-rule-parent-p "def" "begin" "do" "class" "module" "for" "while" "until" "unless" - "if" "then" "elsif" "else" "when" + "if" "then" "elsif" "else" "when" "in" "rescue" "ensure" "{") (smie-rule-parent ruby-indent-level)) ;; For (invalid) code between switch and case. @@ -652,7 +661,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ruby-indent-level)))) (`(:before . ,(or "else" "then" "elsif" "rescue" "ensure")) (smie-rule-parent)) - ('(:before . "when") + (`(:before . ,(or "when" "in")) ;; Align to the previous `when', but look up the virtual ;; indentation of `case'. (if (smie-rule-sibling-p) 0 (smie-rule-parent))) @@ -1722,13 +1731,14 @@ See `add-log-current-defun-function'." (insert "}") (goto-char orig) (delete-char 2) - ;; Maybe this should be customizable, let's see if anyone asks. - (insert "{ ") - (setq beg-marker (point-marker)) - (when (looking-at "\\s +|") - (delete-char (- (match-end 0) (match-beginning 0) 1)) - (forward-char) - (re-search-forward "|" (line-end-position) t)) + (insert "{") + (if (looking-at "\\s +|") + (progn + (just-one-space (if ruby-toggle-block-space-before-parameters 1 0)) + (setq beg-marker (point-marker)) + (forward-char) + (re-search-forward "|" (line-end-position) t)) + (setq beg-marker (point-marker))) (save-excursion (skip-chars-forward " \t\n\r") (setq beg-pos (point)) @@ -2447,6 +2457,13 @@ If there is no Rubocop config file, Rubocop will be passed a flag (setq-local beginning-of-defun-function #'ruby-beginning-of-defun) (setq-local end-of-defun-function #'ruby-end-of-defun) + ;; `outline-regexp' contains the first part of `ruby-indent-beg-re' + (setq-local outline-regexp (concat "^\\s *" + (regexp-opt '("class" "module" "def")) + "\\_>")) + (setq-local outline-level (lambda () (1+ (/ (current-indentation) + ruby-indent-level)))) + (add-hook 'after-save-hook #'ruby-mode-set-encoding nil 'local) (add-hook 'electric-indent-functions #'ruby--electric-indent-p nil 'local) (add-hook 'flymake-diagnostic-functions #'ruby-flymake-auto nil 'local) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 6f47f645e02..e0453c3b2f4 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,7 +1,6 @@ ;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*- -;; Copyright (C) 1986-1988, 1997-1998, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Author: Bill Rozas <jinx@martigny.ai.mit.edu> ;; Adapted-by: Dave Love <d.love@dl.ac.uk> @@ -115,12 +114,53 @@ (define-abbrev-table 'scheme-mode-abbrev-table ()) (defvar scheme-imenu-generic-expression - '((nil - "^(define\\(?:-\\(?:generic\\(?:-procedure\\)?\\|method\\)\\)?\\s-+(?\\(\\sw+\\)" 1) - ("Types" - "^(define-class\\s-+(?\\(\\sw+\\)" 1) - ("Macros" - "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2)) + `((nil + ,(rx bol "(define" + (zero-or-one "*") + (zero-or-one "-public") + (one-or-more space) + (zero-or-one "(") + (group (one-or-more (or word (syntax symbol))))) + 1) + ("Methods" + ,(rx bol "(define-" + (or "generic" "method" "accessor") + (one-or-more space) + (zero-or-one "(") + (group (one-or-more (or word (syntax symbol))))) + 1) + ("Classes" + ,(rx bol "(define-class" + (one-or-more space) + (zero-or-one "(") + (group (one-or-more (or word (syntax symbol))))) + 1) + ("Records" + ,(rx bol "(define-record-type" + (zero-or-one "*") + (one-or-more space) + (group (one-or-more (or word (syntax symbol))))) + 1) + ("Conditions" + ,(rx bol "(define-condition-type" + (one-or-more space) + (group (one-or-more (or word (syntax symbol))))) + 1) + ("Modules" + ,(rx bol "(define-module" + (one-or-more space) + (group "(" (one-or-more any) ")")) + 1) + ("Macros" + ,(rx bol "(" + (or (and "defmacro" + (zero-or-one "*") + (zero-or-one "-public")) + "define-macro" "define-syntax" "define-syntax-rule") + (one-or-more space) + (zero-or-one "(") + (group (one-or-more (or word (syntax symbol))))) + 1)) "Imenu generic expression for Scheme mode. See `imenu-generic-expression'.") (defun scheme-mode-variables () @@ -160,12 +200,10 @@ (defvar scheme-mode-line-process "") -(defvar scheme-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map lisp-mode-shared-map) - map) - "Keymap for Scheme mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") +(defvar-keymap scheme-mode-map + :doc "Keymap for Scheme mode. +All commands in `lisp-mode-shared-map' are inherited by this map." + :parent lisp-mode-shared-map) (easy-menu-define scheme-mode-menu scheme-mode-map "Menu for Scheme mode." @@ -350,12 +388,18 @@ See `run-hooks'." st)) (put 'lambda 'scheme-doc-string-elt 2) +(put 'lambda* 'scheme-doc-string-elt 2) ;; Docstring's pos in a `define' depends on whether it's a var or fun def. (put 'define 'scheme-doc-string-elt (lambda () ;; The function is called with point right after "define". (forward-comment (point-max)) (if (eq (char-after) ?\() 2 0))) +(put 'define* 'scheme-doc-string-elt 2) +(put 'case-lambda 'scheme-doc-string-elt 1) +(put 'case-lambda* 'scheme-doc-string-elt 1) +(put 'define-syntax-rule 'scheme-doc-string-elt 2) +(put 'syntax-rules 'scheme-doc-string-elt 2) (defun scheme-syntax-propertize (beg end) (goto-char beg) @@ -521,10 +565,20 @@ indentation." (lisp-indent-specform 2 state indent-point normal-indent) (lisp-indent-specform 1 state indent-point normal-indent))) -;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented -;; like defun if the first form is placed on the next line, otherwise -;; it is indented like any other form (i.e. forms line up under first). - +;; See `scheme-indent-function' (the function) for what these do. +;; In a nutshell: +;; . for forms with no `scheme-indent-function' property the 2nd +;; and subsequent lines will be indented with one space; +;; . if the value of the property is zero, then when the first form +;; is on a separate line, the next lines will be indented with 2 +;; spaces instead of the default one space; +;; . if the value is a positive integer N, the first N lines after +;; the first one will be indented with 4 spaces, and the rest +;; will be indented with 2 spaces; +;; . if the value is `defun', the indentation is like for `defun'; +;; . if the value is a function, it will be called to produce the +;; required indentation. +;; See also http://community.schemewiki.org/?emacs-indentation. (put 'begin 'scheme-indent-function 0) (put 'case 'scheme-indent-function 1) (put 'delay 'scheme-indent-function 0) @@ -535,12 +589,16 @@ indentation." (put 'letrec 'scheme-indent-function 1) (put 'let-values 'scheme-indent-function 1) ; SRFI 11 (put 'let*-values 'scheme-indent-function 1) ; SRFI 11 +(put 'and-let* 'scheme-indent-function 1) ; SRFI 2 (put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs (put 'let-syntax 'scheme-indent-function 1) (put 'letrec-syntax 'scheme-indent-function 1) -(put 'syntax-rules 'scheme-indent-function 1) +(put 'syntax-rules 'scheme-indent-function 'defun) (put 'syntax-case 'scheme-indent-function 2) ; not r5rs +(put 'with-syntax 'scheme-indent-function 1) (put 'library 'scheme-indent-function 1) ; R6RS +;; Part of at least Guile, Chez Scheme, Chicken +(put 'eval-when 'scheme-indent-function 1) (put 'call-with-input-file 'scheme-indent-function 1) (put 'call-with-port 'scheme-indent-function 1) @@ -564,6 +622,14 @@ indentation." ;; SRFI-8 (put 'receive 'scheme-indent-function 2) +;; SRFI-204 (withdrawn, but provided in many implementations, see the SRFI text) +(put 'match 'scheme-indent-function 1) +(put 'match-lambda 'scheme-indent-function 0) +(put 'match-lambda* 'scheme-indent-function 0) +(put 'match-let 'scheme-indent-function 'scheme-let-indent) +(put 'match-let* 'scheme-indent-function 1) +(put 'match-letrec 'scheme-indent-function 1) + ;;;; MIT Scheme specific indentation. (if scheme-mit-dialect diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index e0d597d89de..be9f325d93d 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -286,7 +286,7 @@ naming the shell." :group 'sh-script) (defcustom sh-imenu-generic-expression - '((sh + `((sh . ((nil ;; function FOO ;; function FOO() @@ -295,8 +295,21 @@ naming the shell." ;; FOO() (nil "^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()" - 1) - ))) + 1))) + (mksh + . ((nil + ;; function FOO + ;; function FOO() + ,(rx bol (* (syntax whitespace)) "function" (+ (syntax whitespace)) + (group (1+ (not (any "\0\t\n \"$&'();<=>\\`|#*?[]/")))) + (* (syntax whitespace)) (? "()")) + 1) + (nil + ;; FOO() + ,(rx bol (* (syntax whitespace)) + (group (1+ (not (any "\0\t\n \"$&'();<=>\\`|#*?[]/")))) + (* (syntax whitespace)) "()") + 1)))) "Alist of regular expressions for recognizing shell function definitions. See `sh-feature' and `imenu-generic-expression'." :type '(alist :key-type (symbol :tag "Shell") @@ -306,7 +319,7 @@ See `sh-feature' and `imenu-generic-expression'." :value-type (repeat :tag "Regexp, index..." sexp))) :group 'sh-script - :version "20.4") + :version "29.1") (defun sh-current-defun-name () "Find the name of function or variable at point. @@ -641,7 +654,12 @@ implemented as aliases. See `sh-feature'." :version "24.4" ; bash4 additions :group 'sh-script) - +(defcustom sh-indent-statement-after-and t + "How to indent statements following && in Shell-Script mode. +If t, indent to align with &&. +If nil, indent to align with the previous line's indentation." + :type 'boolean + :version "29.1") (defcustom sh-leading-keywords '((bash sh-append sh @@ -1138,8 +1156,8 @@ Can be set to a number, or to nil which means leave it as is." "The default indentation increment. This value is used for the `+' and `-' symbols in an indentation variable." :type 'integer + :safe #'integerp :group 'sh-indentation) -(put 'sh-basic-offset 'safe-local-variable 'integerp) (defcustom sh-indent-comment t "How a comment line is to be indented. @@ -1407,10 +1425,10 @@ If FORCE is non-nil and no process found, create one." (defun sh-show-shell () "Pop the shell interaction buffer." (interactive) - (pop-to-buffer (process-buffer (sh-shell-process t)))) + (pop-to-buffer (process-buffer (sh-shell-process t)) display-comint-buffer-action)) (defun sh-send-text (text) - "Send the text to the `sh-shell-process'." + "Send TEXT to `sh-shell-process'." (comint-send-string (sh-shell-process t) (concat text "\n"))) (defun sh-cd-here () @@ -1538,6 +1556,11 @@ with your script for an edit-interpret-debug cycle." (add-hook 'completion-at-point-functions #'sh-completion-at-point-function nil t) (setq-local outline-regexp "###") + (setq-local escaped-string-quote + (lambda (terminator) + (if (eq terminator ?') + "'\\'" + "\\"))) ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell @@ -1549,7 +1572,7 @@ with your script for an edit-interpret-debug cycle." ;; Checks that use `buffer-file-name' follow. ((string-match "\\.m?spec\\'" buffer-file-name) "rpm") ((string-match "[.]sh\\>" buffer-file-name) "sh") - ((string-match "[.]bash\\>" buffer-file-name) "bash") + ((string-match "[.]bash\\(rc\\)?\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh") ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") @@ -1602,7 +1625,7 @@ This adds rules for comments and assignments." ;;; Completion -(defvar sh--completion-keywords '("if" "while" "until" "for")) +(defvar sh--completion-keywords '("if" "while" "until" "for" "then")) (defun sh--vars-before-point () (save-excursion @@ -1774,21 +1797,27 @@ Does not preserve point." (n (skip-syntax-backward "."))) (if (or (zerop n) (and (eq n -1) + ;; Skip past quoted white space. (let ((p (point))) (if (eq -1 (% (skip-syntax-backward "\\") 2)) t (goto-char p) nil)))) (while - (progn (skip-syntax-backward ".w_'") - (or (not (zerop (skip-syntax-backward "\\"))) - (when (eq ?\\ (char-before (1- (point)))) - (let ((p (point))) - (forward-char -1) - (if (eq -1 (% (skip-syntax-backward "\\") 2)) - t - (goto-char p) - nil)))))) + (progn + ;; Skip past words, but stop at semicolons. + (while (and (not (zerop (skip-syntax-backward "w_'"))) + (not (eq (char-before (point)) ?\;)) + (skip-syntax-backward "."))) + (or (not (zerop (skip-syntax-backward "\\"))) + ;; Skip past quoted white space. + (when (eq ?\\ (char-before (1- (point)))) + (let ((p (point))) + (forward-char -1) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))))) (goto-char (- (point) (% (skip-syntax-backward "\\") 2)))) (buffer-substring-no-properties (point) pos))) @@ -1897,9 +1926,9 @@ With t, you get the latter as long as that would indent the continuation line deeper than the initial line." :version "25.1" :type '(choice - (const nil :tag "Never") - (const t :tag "Only if needed to make it deeper") - (const always :tag "Always")) + (const :value nil :tag "Never") + (const :value t :tag "Only if needed to make it deeper") + (const :value always :tag "Always")) :group 'sh-indentation) (defun sh-smie--continuation-start-indent () @@ -1973,7 +2002,7 @@ May return nil if the line should not be treated as continued." (cons 'column (smie-indent-keyword ";")) (smie-rule-separator kind))) (`(:after . ,(or ";;" ";&" ";;&")) - (with-demoted-errors + (with-demoted-errors "SMIE rule error: %S" (smie-backward-sexp token) (cons 'column (if (or (smie-rule-bolp) @@ -1984,7 +2013,9 @@ May return nil if the line should not be treated as continued." (current-column) (smie-indent-calculate))))) (`(:before . ,(or "|" "&&" "||")) - (unless (smie-rule-parent-p token) + (when (and (not (smie-rule-parent-p token)) + (or (not (equal token "&&")) + sh-indent-statement-after-and)) (smie-backward-sexp token) `(column . ,(+ (funcall smie-rules-function :elem 'basic) (smie-indent-virtual))))) @@ -2379,6 +2410,8 @@ Lines containing only comments are considered empty." The working directory is that of the buffer, and only environment variables are already set which is why you can mark a header within the script. +The executed subshell is `sh-shell-file'. + With a positive prefix ARG, instead of sending region, define header from beginning of buffer to point. With a negative prefix ARG, instead of sending region, clear header." @@ -2386,17 +2419,18 @@ region, clear header." (if flag (setq sh-header-marker (if (> (prefix-numeric-value flag) 0) (point-marker))) - (if sh-header-marker - (save-excursion - (let (buffer-undo-list) - (goto-char sh-header-marker) - (append-to-buffer (current-buffer) start end) - (shell-command-on-region (point-min) - (setq end (+ sh-header-marker - (- end start))) - sh-shell-file) - (delete-region sh-header-marker end))) - (shell-command-on-region start end (concat sh-shell-file " -"))))) + (let ((shell-file-name sh-shell-file)) + (if sh-header-marker + (save-excursion + (let (buffer-undo-list) + (goto-char sh-header-marker) + (append-to-buffer (current-buffer) start end) + (shell-command-on-region (point-min) + (setq end (+ sh-header-marker + (- end start))) + sh-shell-file) + (delete-region sh-header-marker end))) + (shell-command-on-region start end (concat sh-shell-file " -")))))) (defun sh-remember-variable (var) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 69d16a4357e..b950f93f2a0 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -274,8 +274,8 @@ file. Since that is a plaintext file, this could be dangerous." (defcustom sql-port 0 "Default port for connecting to a MySQL or Postgres server." :version "24.1" - :type 'number - :safe 'numberp) + :type 'natnum + :safe 'natnump) (defcustom sql-default-directory nil "Default directory for SQL processes." @@ -3216,7 +3216,7 @@ For both `:file' and `:completion', there can also be a (cond ((plist-member plist :file) (let ((file-name - (read-file-name prompt + (read-file-name prompt-def (file-name-directory last-value) default (if (plist-member plist :must-match) @@ -3246,7 +3246,7 @@ For both `:file' and `:completion', there can also be a default)) ((plist-get plist :number) - (read-number prompt (or default last-value 0))) + (read-number (concat prompt ": ") (or default last-value 0))) (t (read-string prompt-def last-value history-var default)))))) @@ -3318,7 +3318,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port @@ -3648,94 +3648,69 @@ Allows the suppression of continuation prompts.") (defvar sql-preoutput-hold nil) -(defun sql-starts-with-prompt-re () - "Anchor the prompt expression at the beginning of the output line. -Remove the start of line regexp." - (concat "\\`" comint-prompt-regexp)) - -(defun sql-ends-with-prompt-re () - "Anchor the prompt expression at the end of the output line. -Match a SQL prompt or a password prompt." - (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|" - "\\(?:" comint-password-prompt-regexp "\\)\\)\\'")) - (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. Added to the `comint-preoutput-filter-functions' hook in a SQL -interactive buffer. If `sql-output-newline-count' is greater than -zero, then an output line matching the continuation prompt is filtered -out. If the count is zero, then a newline is inserted into the output -to force the output from the query to appear on a new line. - -The complication to this filter is that the continuation prompts -may arrive in multiple chunks. If they do, then the function -saves any unfiltered output in a buffer and prepends that buffer -to the next chunk to properly match the broken-up prompt. - -If the filter gets confused, it should reset and stop filtering -to avoid deleting non-prompt output." - - ;; continue gathering lines of text iff - ;; + we know what a prompt looks like, and - ;; + there is held text, or - ;; + there are continuation prompt yet to come, or - ;; + not just a prompt string +interactive buffer. The complication to this filter is that the +continuation prompts may arrive in multiple chunks. If they do, +then the function saves any unfiltered output in a buffer and +prepends that buffer to the next chunk to properly match the +broken-up prompt. + +The filter goes into play only if something is already +accumulated, or we're waiting for continuation +prompts (`sql-output-newline-count' is positive). In this case: +- Accumulate process output into `sql-preoutput-hold'. +- Remove any complete prompts / continuation prompts that we're waiting + for. +- In case we're expecting more prompts - return all currently + accumulated _complete_ lines, leaving the rest for the next + invocation. They will appear in the output immediately. This way we + don't accumulate large chunks of data for no reason. +- If we found all expected prompts - just return all current accumulated + data." (when (and comint-prompt-regexp - (or (> (length (or sql-preoutput-hold "")) 0) - (> (or sql-output-newline-count 0) 0) - (not (or (string-match sql-prompt-regexp oline) - (and sql-prompt-cont-regexp - (string-match sql-prompt-cont-regexp oline)))))) - + ;; We either already have something held, or expect + ;; prompts + (or sql-preoutput-hold + (and sql-output-newline-count + (> sql-output-newline-count 0)))) (save-match-data - (let (prompt-found last-nl) - - ;; Add this text to what's left from the last pass - (setq oline (concat sql-preoutput-hold oline) - sql-preoutput-hold "") - - ;; If we are looking for multiple prompts - (when (and (integerp sql-output-newline-count) - (>= sql-output-newline-count 1)) - ;; Loop thru each starting prompt and remove it - (let ((start-re (sql-starts-with-prompt-re))) - (while (and (not (string= oline "")) - (> sql-output-newline-count 0) - (string-match start-re oline)) - (setq oline (replace-match "" nil nil oline) - sql-output-newline-count (1- sql-output-newline-count) - prompt-found t))) - - ;; If we've found all the expected prompts, stop looking - (if (= sql-output-newline-count 0) - (setq sql-output-newline-count nil) - - ;; Still more possible prompts, leave them for the next pass - (setq sql-preoutput-hold oline - oline ""))) - - ;; If no prompts were found, stop looking - (unless prompt-found - (setq sql-output-newline-count nil - oline (concat oline sql-preoutput-hold) - sql-preoutput-hold "")) - - ;; Break up output by physical lines if we haven't hit the final prompt - (let ((end-re (sql-ends-with-prompt-re))) - (unless (and (not (string= oline "")) - (string-match end-re oline) - (>= (match-end 0) (length oline))) - ;; Find everything upto the last nl - (setq last-nl 0) - (while (string-match "\n" oline last-nl) - (setq last-nl (match-end 0))) - ;; Hold after the last nl, return upto last nl - (setq sql-preoutput-hold (concat (substring oline last-nl) - sql-preoutput-hold) - oline (substring oline 0 last-nl))))))) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold nil) + + ;; If we are looking for prompts + (when (and sql-output-newline-count + (> sql-output-newline-count 0)) + ;; Loop thru each starting prompt and remove it + (while (and (not (string-empty-p oline)) + (> sql-output-newline-count 0) + (string-match comint-prompt-regexp oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count))) + + ;; If we've found all the expected prompts, stop looking + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil) + ;; Still more possible prompts, leave them for the next pass + (setq sql-preoutput-hold oline + oline ""))) + + ;; Lines that are now complete may be passed further + (when sql-preoutput-hold + (let ((last-nl 0)) + (while (string-match "\n" sql-preoutput-hold last-nl) + (setq last-nl (match-end 0))) + ;; Return up to last nl, hold after the last nl + (setq oline (substring sql-preoutput-hold 0 last-nl) + sql-preoutput-hold (substring sql-preoutput-hold last-nl)) + (when (string-empty-p sql-preoutput-hold) + (setq sql-preoutput-hold nil)))))) oline) + ;;; Sending the region to the SQLi buffer. (defvar sql-debug-send nil "Display text sent to SQL process pragmatically.") @@ -4184,18 +4159,35 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (setq-local sql-contains-names t) + (setq-local escaped-string-quote "'") (setq-local syntax-propertize-function - (syntax-propertize-rules - ;; Handle escaped apostrophes within strings. - ("''" - (0 - (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) - (string-to-syntax ".") - (forward-char -1) - nil))) - ;; Propertize rules to not have /- and -* start comments. - ("\\(/-\\)" (1 ".")) - ("\\(-\\*\\)" (1 ".")))) + (eval + '(syntax-propertize-rules + ;; Handle escaped apostrophes within strings. + ((if (eq sql-product 'mysql) + "\\\\'" + "''") + (0 + (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (forward-char -1) + nil))) + ;; Propertize rules to not have /- and -* start comments. + ("\\(/-\\)" (1 ".")) + ("\\(-\\*\\)" + (1 + (if (save-excursion + (not (ppss-comment-depth + (syntax-ppss (match-beginning 1))))) + ;; If we're outside a comment, we don't let -* + ;; start a comment. + (string-to-syntax ".") + ;; Inside a comment, ignore it to avoid -*/ not + ;; being interpreted as a comment end. + (forward-char -1) + nil)))) + t)) ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 @@ -4633,6 +4625,9 @@ the call to \\[sql-product-interactive] with (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Also set the global value. + (setq-default sql-buffer (buffer-name new-sqli-buffer)) + ;; Make sure the connection is complete ;; (Sometimes start up can be slow) ;; and call the login hook diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index b1b78b4d128..e06eb9a6f70 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -264,8 +264,8 @@ Optional argument ARG is the same as for `capitalize-word'." "Toggle superword movement and editing (Superword mode). Superword mode is a buffer-local minor mode. Enabling it changes -the definition of words such that symbols characters are treated -as parts of words: e.g., in `superword-mode', +the definition of words such that characters which have symbol +syntax are treated as parts of words: e.g., in `superword-mode', \"this_is_a_symbol\" counts as one word. \\{superword-mode-map}" diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index ed6dce02c03..7dae14f9e02 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -120,13 +120,13 @@ (defcustom tcl-indent-level 4 "Indentation of Tcl statements with respect to containing block." - :type 'integer) -(put 'tcl-indent-level 'safe-local-variable #'integerp) + :type 'integer + :safe #'integerp) (defcustom tcl-continued-indent-level 4 "Indentation of continuation line relative to first line of command." - :type 'integer) -(put 'tcl-continued-indent-level 'safe-local-variable #'integerp) + :type 'integer + :safe #'integerp) (defcustom tcl-auto-newline nil "Non-nil means automatically newline before and after braces you insert." @@ -344,7 +344,7 @@ information): Add functions to the hook with `add-hook': - (add-hook 'tcl-mode-hook #'tcl-guess-application)") + (add-hook \\='tcl-mode-hook #\\='tcl-guess-application)") (defvar tcl-proc-list diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index edce3fef6cf..31d50a1882e 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3622,10 +3622,10 @@ is 0. Meaning of *single* declaration: E.g. In a module's port-list - module test(input clk, rst, x, output [1:0] y); - Here 'input clk, rst, x' is 1 *single* declaration statement, -and 'output [1:0] y' is the other single declaration. In the 1st single -declaration, POINT is moved to start of 'clk'. And in the 2nd declaration, -POINT is moved to 'y'." + Here `input clk, rst, x' is 1 *single* declaration statement, +and `output [1:0] y' is the other single declaration. In the 1st single +declaration, POINT is moved to start of `clk'. And in the 2nd declaration, +POINT is moved to `y'." (let (maxpoint old-point) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index c6693b4de53..39c5eb453b1 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -153,7 +153,11 @@ (defvar lazy-lock-defer-on-scrolling) (defvar lazy-lock-defer-on-the-fly) (defvar speedbar-attached-frame) - +(defvar arch-alist) +(defvar pack-alist) +(defvar file-alist) +(defvar unit-alist) +(defvar rule-alist) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables @@ -8396,30 +8400,30 @@ buffer." ((visible-list (vhdl-get-visible-signals)) ;; define syntactic regions where signals are read (scan-regions-list - '(;; right-hand side of signal/variable assignment + `(;; right-hand side of signal/variable assignment ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) + ((vhdl-re-search-forward "[<:]=" ,proc-end t) + (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) - (vhdl-re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) + (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) ;; elsif condition - ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) - (vhdl-re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t) + (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) - (vhdl-re-search-forward "\\<loop\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) + (vhdl-re-search-forward "\\<loop\\>" ,proc-end t)) ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) - (vhdl-re-search-forward ";" proc-end t)) + ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) + (vhdl-re-search-forward ";" ,proc-end t)) ;; assert condition - ((vhdl-re-search-forward "\\<assert\\>" proc-end t) - (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) + ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t) + (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t)) ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) - (vhdl-re-search-forward "\\<is\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) + (vhdl-re-search-forward "\\<is\\>" ,proc-end t)) ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) (1- (point))) (progn (backward-char) (forward-sexp) (while (looking-at "(") (forward-sexp)) (point))))) @@ -8785,7 +8789,10 @@ project is defined." (defun vhdl-electric-period (count) "`..' --> ` => '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) vhdl-last-input-event) + ;; We use this-command-keys below to account for translation of + ;; kp-decimal into '.'; vhdl-last-input-event doesn't catch + ;; that. + (cond ((eq (preceding-char) (aref (this-command-keys) 0)) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "=> "))) @@ -14949,10 +14956,10 @@ otherwise use cached data." (vhdl-speedbar-expand-units directory) (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) -(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist - ent-inst-list depth) - "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." - (if (not (or ent-alist conf-alist pack-alist)) +(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg + package-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACKAGE-ALIST." + (if (not (or ent-alist conf-alist package-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -14982,15 +14989,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while pack-alist - (setq pack-entry (car pack-alist)) + (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while package-alist + (setq pack-entry (car package-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq pack-alist (cdr pack-alist)))))) + (setq package-alist (cdr package-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) @@ -17209,6 +17216,7 @@ specified by a target." (unless (or (assoc directory vhdl-file-alist) (vhdl-load-cache directory)) (vhdl-scan-directory-contents directory)))) + (defvar rule-alist) ; we need it to be dynamically bound (let* ((directory (abbreviate-file-name (vhdl-default-directory))) (project (vhdl-project-p)) (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 4388b0e7de0..2e8e8d23192 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -64,7 +64,7 @@ ;; Variables for customization ;; --------------------------- ;; -(defvar which-func-unknown "???" +(defvar which-func-unknown "n/a" "String to display in the mode line when current function is unknown.") (defgroup which-func nil @@ -216,7 +216,7 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil)))) (defun which-func-update () - "Update the Which-Function mode display for all windows." + "Update the Which-Function mode display in the current window." ;; (walk-windows 'which-func-update-1 nil 'visible)) (let ((non-essential t)) (which-func-update-1 (selected-window)))) @@ -234,9 +234,6 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil) (error "Error in which-func-update: %S" info)))))) -;;;###autoload -(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") - (defvar which-func-update-timer nil) (unless (or (assq 'which-func-mode mode-line-misc-info) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 9ce63a8f8a1..0213ab3cc58 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. -;; Version: 1.3.2 +;; Version: 1.4.1 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -118,16 +118,16 @@ When it is a file name, it should be the \"expanded\" version.") (defcustom xref-file-name-display 'project-relative "Style of file name display in *xref* buffers. -If the value is the symbol `abs', the default, show the file names -in their full absolute form. +If the value is the symbol `abs', show the file names in their +full absolute form. If `nondirectory', show only the nondirectory (a.k.a. \"base name\") part of the file name. -If `project-relative', show only the file name relative to the -current project root. If there is no current project, or if the -file resides outside of its root, show that particular file name -in its full absolute form." +If `project-relative', the default, show only the file name +relative to the current project root. If there is no current +project, or if the file resides outside of its root, show that +particular file name in its full absolute form." :type '(choice (const :tag "absolute file name" abs) (const :tag "nondirectory file name" nondirectory) (const :tag "relative to project root" project-relative)) @@ -227,7 +227,7 @@ This behavior is new in Emacs 28.") "A match xref item describes a search result." length) -(cl-defgeneric xref-match-length ((item xref-match-item)) +(cl-defmethod xref-match-length ((item xref-match-item)) "Return the length of the match." (xref-match-item-length item)) @@ -381,7 +381,8 @@ elements is negated: these commands will NOT prompt." (defcustom xref-after-jump-hook '(recenter xref-pulse-momentarily) - "Functions called after jumping to an xref." + "Functions called after jumping to an xref. +Also see `xref-current-item'." :type 'hook) (defcustom xref-after-return-hook '(xref-pulse-momentarily) @@ -426,7 +427,7 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(make-obsolete-variable 'xref-marker-ring nil "29.1") +(make-obsolete-variable 'xref--marker-ring 'xref--history "29.1") (defun xref-set-marker-ring-length (_var _val) (declare (obsolete nil "29.1")) @@ -485,13 +486,20 @@ To undo, use \\[xref-go-forward]." (set-marker marker nil nil) (run-hooks 'xref-after-return-hook)))) -(defvar xref--current-item nil) +(define-obsolete-variable-alias + 'xref--current-item + 'xref-current-item + "29.1") + +(defvar xref-current-item nil + "Dynamically bound to the current item being processed. +This can be used from `xref-after-jump-hook', for instance.") (defun xref-pulse-momentarily () (pcase-let ((`(,beg . ,end) (save-excursion (or - (let ((length (xref-match-length xref--current-item))) + (let ((length (xref-match-length xref-current-item))) (and length (cons (point) (+ (point) length)))) (back-to-indentation) (if (eolp) @@ -548,7 +556,7 @@ If SELECT is non-nil, select the target window." (window (pop-to-buffer buf t)) (frame (let ((pop-up-frames t)) (pop-to-buffer buf t)))) (xref--goto-char marker)) - (let ((xref--current-item item)) + (let ((xref-current-item item)) (run-hooks 'xref-after-jump-hook))) @@ -637,9 +645,15 @@ SELECT is `quit', also quit the *xref* window." (xref-buffer (current-buffer))) (cond (select (if (eq select 'quit) (quit-window nil nil)) - (select-window - (with-current-buffer xref-buffer - (xref--show-pos-in-buf marker buf)))) + (let* ((old-frame (selected-frame)) + (window (with-current-buffer xref-buffer + (xref--show-pos-in-buf marker buf))) + (frame (window-frame window))) + ;; If we chose another frame, make sure it gets input + ;; focus. + (unless (eq frame old-frame) + (select-frame-set-input-focus frame)) + (select-window window))) (t (save-selected-window (xref--with-dedicated-window @@ -656,7 +670,7 @@ SELECT is `quit', also quit the *xref* window." "Display the source of xref at point in the appropriate window, if any." (interactive) (let* ((xref (xref--item-at-point)) - (xref--current-item xref)) + (xref-current-item xref)) (when xref (xref--set-arrow) (xref--show-location (xref-item-location xref))))) @@ -715,7 +729,7 @@ quit the *xref* buffer." (let* ((buffer (current-buffer)) (xref (or (xref--item-at-point) (user-error "Choose a reference to visit"))) - (xref--current-item xref)) + (xref-current-item xref)) (xref--set-arrow) (xref--show-location (xref-item-location xref) (if quit 'quit t)) (if (fboundp 'next-error-found) @@ -738,11 +752,25 @@ quit the *xref* buffer." "Perform interactive replacement of FROM with TO in all displayed xrefs. This command interactively replaces FROM with TO in the names of the -references displayed in the current *xref* buffer." +references displayed in the current *xref* buffer. + +When called interactively, it uses '.*' as FROM, which means +replace the whole name. Unless called with prefix argument, in +which case the user is prompted for both FROM and TO. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive - (let ((fr (read-regexp "Xref query-replace (regexp)" ".*"))) - (list fr - (read-regexp (format "Xref query-replace (regexp) %s with: " fr))))) + (let* ((fr + (if current-prefix-arg + (read-regexp "Query-replace (regexp)" ".*") + ".*")) + (prompt (if current-prefix-arg + (format "Query-replace (regexp) %s with: " fr) + "Query-replace all matches with: "))) + (list fr (read-regexp prompt)))) (let* (item xrefs iter) (save-excursion (while (setq item (xref--search-property 'xref-item)) @@ -936,15 +964,15 @@ beginning of the line." (let ((win (get-buffer-window (current-buffer)))) (and win (set-window-point win (point)))) (xref--set-arrow) - (let ((xref--current-item xref)) + (let ((xref-current-item xref)) (xref--show-location (xref-item-location xref) t))) (t (error "No %s xref" (if backward "previous" "next")))))) (defvar xref--button-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'xref-goto-xref) - (define-key map [mouse-2] #'xref-select-and-show-xref) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] #'xref-goto-xref) map)) (defun xref-select-and-show-xref (event) @@ -1093,6 +1121,13 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)." (cdr pair))) alist))) +(defun xref--ensure-default-directory (dd buffer) + ;; We might be in a let-binding which will restore the current value + ;; to a previous one (bug#53626). So do this later. + (run-with-timer + 0 nil + (lambda () (with-current-buffer buffer (setq default-directory dd))))) + (defun xref--show-xref-buffer (fetcher alist) (cl-assert (functionp fetcher)) (let* ((xrefs @@ -1103,7 +1138,7 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)." (dd default-directory) buf) (with-current-buffer (get-buffer-create xref-buffer-name) - (setq default-directory dd) + (xref--ensure-default-directory dd (current-buffer)) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) @@ -1202,7 +1237,7 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (assoc-default 'display-action alist))) (t (with-current-buffer (get-buffer-create xref-buffer-name) - (setq default-directory dd) + (xref--ensure-default-directory dd (current-buffer)) (xref--transient-buffer-mode) (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) (pop-to-buffer (current-buffer) @@ -1326,6 +1361,13 @@ definitions." (defvar xref--read-pattern-history nil) +;;;###autoload +(defun xref-show-xrefs (fetcher display-action) + "Display some Xref values produced by FETCHER using DISPLAY-ACTION. +The meanings of both arguments are the same as documented in +`xref-show-xrefs-function'." + (xref--show-xrefs fetcher display-action)) + (defun xref--show-xrefs (fetcher display-action &optional _always-show-list) (xref--push-markers) (unless (functionp fetcher) @@ -1469,6 +1511,23 @@ is nil, prompt only if there's no usable symbol at point." (interactive (list (xref--read-identifier "Find references of: "))) (xref--find-xrefs identifier 'references identifier nil)) +(defun xref-find-references-and-replace (from to) + "Replace all references to identifier FROM with TO." + (interactive + (let* ((query-replace-read-from-default 'find-tag-default) + (common + (query-replace-read-args "Query replace identifier" nil))) + (list (nth 0 common) (nth 1 common)))) + (require 'xref) + (with-current-buffer + (let ((xref-show-xrefs-function + ;; Some future-proofing (bug#44905). + (custom--standard-value 'xref-show-xrefs-function)) + ;; Disable auto-jumping, it will mess up replacement logic. + xref-auto-jump-to-first-xref) + (xref-find-references from)) + (xref-query-replace-in-results ".*" to))) + ;;;###autoload (defun xref-find-definitions-at-mouse (event) "Find the definition of identifier at or around mouse click. @@ -1496,7 +1555,7 @@ This command is intended to be bound to a mouse event." (xref-find-references identifier)) (user-error "No identifier here")))) -(declare-function apropos-parse-pattern "apropos" (pattern)) +(declare-function apropos-parse-pattern "apropos" (pattern &optional do-all)) ;;;###autoload (defun xref-find-apropos (pattern) @@ -1669,8 +1728,9 @@ IGNORES is a list of glob patterns for files to ignore." (ripgrep . ;; '!*/' is there to filter out dirs (e.g. submodules). - "xargs -0 rg <C> --null -nH --no-messages -g '!*/' -e <R>" - )) + "xargs -0 rg <C> --null -nH --no-heading --no-messages -g '!*/' -e <R>" + ) + (ugrep . "xargs -0 ugrep <C> --null -ns -e <R>")) "Associative list mapping program identifiers to command templates. Program identifier should be a symbol, named after the search program. @@ -1699,6 +1759,7 @@ utility function used by commands like `dired-do-find-regexp' and :type '(choice (const :tag "Use Grep" grep) (const :tag "Use ripgrep" ripgrep) + (const :tag "Use ugrep" ugrep) (symbol :tag "User defined")) :version "28.1" :package-version '(xref . "1.0.4")) @@ -1818,7 +1879,7 @@ to control which program to use when looking for matches." (xref--find-ignores-arguments ignores dir))) (defun xref--find-ignores-arguments (ignores dir) - "Convert IGNORES and DIR to a list of arguments for 'find'. + "Convert IGNORES and DIR to a list of arguments for `find'. IGNORES is a list of glob patterns. DIR is an absolute directory, used as the root of the ignore globs." (cl-assert (not (string-match-p "\\`~" dir))) @@ -1878,21 +1939,22 @@ Such as the current syntax table and the applied syntax properties." (defvar xref--last-file-buffer nil) (defvar xref--temp-buffer-file-name nil) +(defvar xref--hits-remote-id nil) (defun xref--convert-hits (hits regexp) (let (xref--last-file-buffer (tmp-buffer (generate-new-buffer " *xref-temp*")) - (remote-id (file-remote-p default-directory)) + (xref--hits-remote-id (file-remote-p default-directory)) (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (unwind-protect (mapcan (lambda (hit) - (xref--collect-matches hit regexp tmp-buffer remote-id syntax-needed)) + (xref--collect-matches hit regexp tmp-buffer syntax-needed)) hits) (kill-buffer tmp-buffer)))) -(defun xref--collect-matches (hit regexp tmp-buffer remote-id syntax-needed) +(defun xref--collect-matches (hit regexp tmp-buffer syntax-needed) (pcase-let* ((`(,line ,file ,text) hit) - (file (and file (concat remote-id file))) + (file (and file (concat xref--hits-remote-id file))) (buf (xref--find-file-buffer file)) (inhibit-modification-hooks t)) (if buf @@ -1965,10 +2027,17 @@ Such as the current syntax table and the applied syntax properties." (defun xref--find-file-buffer (file) (unless (equal (car xref--last-file-buffer) file) - (setq xref--last-file-buffer - ;; `find-buffer-visiting' is considerably slower, - ;; especially on remote files. - (cons file (get-file-buffer file)))) + ;; `find-buffer-visiting' is considerably slower, + ;; especially on remote files. + (let ((buf (get-file-buffer file))) + (when (and buf + (or + (buffer-modified-p buf) + (unless xref--hits-remote-id + (not (verify-visited-file-modtime (current-buffer)))))) + ;; We can't use buffers whose contents diverge from disk (bug#54025). + (setq buf nil)) + (setq xref--last-file-buffer (cons file buf)))) (cdr xref--last-file-buffer)) (provide 'xref) |