diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 29 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert-font-lock.el | 27 | ||||
| -rw-r--r-- | lisp/net/tramp-androidsu.el | 20 | ||||
| -rw-r--r-- | lisp/net/trampver.el | 2 | ||||
| -rw-r--r-- | lisp/progmodes/scheme.el | 74 | ||||
| -rw-r--r-- | lisp/progmodes/sh-script.el | 8 |
6 files changed, 111 insertions, 49 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2b5eb34e571..5cff86784f0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3402,8 +3402,8 @@ lambda-expression." (t ".")))) (let ((mutargs (function-get (car form) 'mutates-arguments))) (when mutargs - (dolist (idx (if (eq mutargs 'all-but-last) - (number-sequence 1 (- (length form) 2)) + (dolist (idx (if (symbolp mutargs) + (funcall mutargs form) mutargs)) (let ((arg (nth idx form))) (when (and (or (and (eq (car-safe arg) 'quote) @@ -3472,13 +3472,15 @@ lambda-expression." (if byte-compile--for-effect (byte-compile-discard))))) +(defun bytecomp--sort-call-in-place-p (form) + (or (= (length form) 3) ; old-style + (plist-get (cddr form) :in-place))) ; new-style + (defun bytecomp--actually-important-return-value-p (form) "Whether FORM is really a call with a return value that should not go unused. This assumes the function has the `important-return-value' property." (cond ((eq (car form) 'sort) - ;; For `sort', we only care about non-destructive uses. - (and (zerop (% (length form) 2)) ; new-style call - (not (plist-get (cddr form) :in-place)))) + (not (bytecomp--sort-call-in-place-p form))) (t t))) (let ((important-return-value-fns @@ -3504,18 +3506,27 @@ This assumes the function has the `important-return-value' property." (dolist (fn important-return-value-fns) (put fn 'important-return-value t))) +(defun bytecomp--mutargs-nconc (form) + ;; For `nconc', all arguments but the last are mutated. + (number-sequence 1 (- (length form) 2))) + +(defun bytecomp--mutargs-sort (form) + ;; For `sort', the first argument is mutated if the call is in-place. + (and (bytecomp--sort-call-in-place-p form) '(1))) + (let ((mutating-fns ;; FIXME: Should there be a function declaration for this? ;; ;; (FUNC . ARGS) means that FUNC mutates arguments whose indices are - ;; in the list ARGS, starting at 1, or all but the last argument if - ;; ARGS is `all-but-last'. + ;; in the list ARGS, starting at 1. ARGS can also be a function + ;; taking the function call form as argument and returning the + ;; list of indices. '( (setcar 1) (setcdr 1) (aset 1) (nreverse 1) - (nconc . all-but-last) + (nconc . bytecomp--mutargs-nconc) (nbutlast 1) (ntake 2) - (sort 1) + (sort . bytecomp--mutargs-sort) (delq 2) (delete 2) (delete-dups 1) (delete-consecutive-dups 1) (plist-put 1) diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el index e77c8945dc3..c6fd65e1507 100644 --- a/lisp/emacs-lisp/ert-font-lock.el +++ b/lisp/emacs-lisp/ert-font-lock.el @@ -40,31 +40,34 @@ (require 'pcase) (defconst ert-font-lock--face-symbol-re - (rx (one-or-more (or alphanumeric "-" "_" "."))) - "A face symbol matching regex.") + (rx (+ (or alphanumeric "-" "_" "." "/"))) + "A face symbol matching regex. +The regexp cannot use character classes as these can be redefined by the +major mode of the host language.") (defconst ert-font-lock--face-symbol-list-re (rx "(" (* whitespace) - (one-or-more - (seq (regexp ert-font-lock--face-symbol-re) - (* whitespace))) + (? (regexp ert-font-lock--face-symbol-re)) + (* (+ whitespace) + (regexp ert-font-lock--face-symbol-re)) + (* whitespace) ")") "A face symbol list matching regex.") (defconst ert-font-lock--assertion-line-re (rx ;; leading column assertion (arrow/caret) - (group (or "^" "<-")) - (zero-or-more whitespace) + (group-n 1 (or "^" "<-")) + (* whitespace) ;; possible to have many carets on an assertion line - (group (zero-or-more (seq "^" (zero-or-more whitespace)))) + (group-n 2 (* "^" (* whitespace))) ;; optional negation of the face specification - (group (optional "!")) - (zero-or-more whitespace) + (group-n 3 (optional "!")) + (* whitespace) ;; face symbol name or a list of symbols - (group (or (regexp ert-font-lock--face-symbol-re) - (regexp ert-font-lock--face-symbol-list-re)))) + (group-n 4 (or (regexp ert-font-lock--face-symbol-re) + (regexp ert-font-lock--face-symbol-list-re)))) "An ert-font-lock assertion line regex.") (defun ert-font-lock--validate-major-mode (mode) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 09bee323f5e..1ec9247cf3c 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -366,13 +366,19 @@ FUNCTION." ;; suitable options for specifying the mount namespace and ;; suchlike. (setq - p (make-process - :name name :buffer buffer - :command (if (tramp-get-connection-property v "remote-namespace") - (append (list "su" "-mm" "-" user "-c") command) - (append (list "su" "-" user "-c") command)) - :coding coding :noquery noquery :connection-type connection-type - :sentinel sentinel :stderr stderr)) + p (let ((android-use-exec-loader nil)) + (make-process + :name name + :buffer buffer + :command + (if (tramp-get-connection-property v "remote-namespace") + (append (list "su" "-mm" "-" user "-c") command) + (append (list "su" "-" user "-c") command)) + :coding coding + :noquery noquery + :connection-type connection-type + :sentinel sentinel + :stderr stderr))) ;; Set filter. Prior Emacs 29.1, it doesn't work reliably ;; to provide it as `make-process' argument when filter is ;; t. See Bug#51177. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index c131d39c110..41647d42cc5 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -105,7 +105,7 @@ ("2.3.5.26.3" . "26.3") ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2") ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") ("2.5.4" . "28.3") - ("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2"))) + ("2.6.0.29.1" . "29.1") ("2.6.2.29.2" . "29.2") ("2.6.3-pre" . "29.3"))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 67abab6913d..79d076ff145 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -50,6 +50,7 @@ ;;; Code: (require 'lisp-mode) +(eval-when-compile 'subr-x) ;For `named-let'. (defvar scheme-mode-syntax-table (let ((st (make-syntax-table)) @@ -409,26 +410,73 @@ See `run-hooks'." (defun scheme-syntax-propertize (beg end) (goto-char beg) - (scheme-syntax-propertize-sexp-comment (point) end) + (scheme-syntax-propertize-sexp-comment end) + (scheme-syntax-propertize-regexp end) (funcall (syntax-propertize-rules ("\\(#\\);" (1 (prog1 "< cn" - (scheme-syntax-propertize-sexp-comment (point) end))))) + (scheme-syntax-propertize-sexp-comment end)))) + ("\\(#\\)/" (1 (when (null (nth 8 (save-excursion + (syntax-ppss (match-beginning 0))))) + (put-text-property + (match-beginning 1) + (match-end 1) + 'syntax-table (string-to-syntax "|")) + (scheme-syntax-propertize-regexp end) + nil)))) (point) end)) -(defun scheme-syntax-propertize-sexp-comment (_ end) - (let ((state (syntax-ppss))) +(defun scheme-syntax-propertize-sexp-comment (end) + (let ((state (syntax-ppss)) + (checked (point))) (when (eq 2 (nth 7 state)) ;; It's a sexp-comment. Tell parse-partial-sexp where it ends. - (condition-case nil - (progn - (goto-char (+ 2 (nth 8 state))) - ;; FIXME: this doesn't handle the case where the sexp - ;; itself contains a #; comment. - (forward-sexp 1) - (put-text-property (1- (point)) (point) - 'syntax-table (string-to-syntax "> cn"))) - (scan-error (goto-char end)))))) + (named-let loop ((startpos (+ 2 (nth 8 state)))) + (let ((found nil)) + (while + (progn + (setq found nil) + (condition-case nil + (progn + (goto-char startpos) + (forward-sexp 1) + (setq found (point))) + (scan-error (goto-char end))) + ;; If there's a nested `#;', the syntax-tables will normally + ;; consider the `;' to start a normal comment, so the + ;; (forward-sexp 1) above may have landed at the wrong place. + ;; So look for `#;' in the text over which we jumped, and + ;; mark those we found as nested sexp-comments. + (let ((limit (or found end))) + (when (< checked limit) + (goto-char checked) + (when (re-search-forward "\\(#\\);" limit 'move) + (setq checked (point)) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table + (string-to-syntax "< cn")) + (loop (point))) + (< (point) limit))))) + (when found + (goto-char found) + (put-text-property (1- found) found + 'syntax-table (string-to-syntax "> cn")))))))) + +(defun scheme-syntax-propertize-regexp (end) + (let* ((state (syntax-ppss)) + (within-str (nth 3 state)) + (start-delim-pos (nth 8 state))) + (when (and within-str + (char-equal ?# (char-after start-delim-pos))) + (while (and (re-search-forward "/" end 'move) + (eq -1 + (% (save-excursion + (backward-char) + (skip-chars-backward "\\\\")) + 2)))) + (when (< (point) end) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax "|")))))) ;;;###autoload (define-derived-mode dsssl-mode scheme-mode "DSSSL" diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ab95dc9f924..20c9e00edbf 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -3194,12 +3194,6 @@ shell command and conveniently use this command." (defvar-local sh--shellcheck-process nil) -(defalias 'sh--json-read - (if (fboundp 'json-parse-buffer) - (lambda () (json-parse-buffer :object-type 'alist)) - (require 'json) - 'json-read)) - (defun sh-shellcheck-flymake (report-fn &rest _args) "Flymake backend using the shellcheck program. Takes a Flymake callback REPORT-FN as argument, as expected of a @@ -3223,7 +3217,7 @@ member of `flymake-diagnostic-functions'." (with-current-buffer (process-buffer proc) (goto-char (point-min)) (thread-last - (sh--json-read) + (json-parse-buffer :object-type 'alist) (alist-get 'comments) (seq-filter (lambda (item) |