From 400df210ce0cc1ee0113b14a5ad92764d148c620 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 6 Aug 2023 17:03:26 +0300 Subject: [PATCH 1/4] Fix last change of 'delete-file' * src/fileio.c (Fdelete_file_internal): Expand file name here, as all primitives must. (internal_delete_file): Adjust to the fact that Fdelete_file was renamed. * lisp/files.el (delete-file): Don't expand-file-name here, as the called primitives already do. Fix typo in doc string. --- lisp/files.el | 4 ++-- src/fileio.c | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 84a8c308b09..cc6e860319e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6354,7 +6354,7 @@ non-nil and if FN fails due to a missing file or directory." (defun delete-file (filename &optional trash) "Delete file named FILENAME. If it is a symlink, remove the symlink. -If file has multiple names, it continues to exist with the other names.q +If file has multiple names, it continues to exist with the other names. TRASH non-nil means to trash the file instead of deleting, provided `delete-by-moving-to-trash' is non-nil. @@ -6367,7 +6367,7 @@ With a prefix argument, TRASH is nil." (null current-prefix-arg))) (if (and (file-directory-p filename) (not (file-symlink-p filename))) (signal 'file-error (list "Removing old name: is a directory" filename))) - (let* ((filename (expand-file-name filename)) (handler (find-file-name-handler filename 'delete-file))) + (let* ((handler (find-file-name-handler filename 'delete-file))) (cond (handler (funcall handler 'delete-file filename trash)) ((and delete-by-moving-to-trash trash) (move-file-to-trash filename)) (t (delete-file-internal filename))))) diff --git a/src/fileio.c b/src/fileio.c index e49a4a3836b..18879aa8fa3 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2463,12 +2463,14 @@ DEFUN ("delete-directory-internal", Fdelete_directory_internal, } DEFUN ("delete-file-internal", Fdelete_file_internal, Sdelete_file_internal, 1, 1, 0, - doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink. + doc: /* Delete file named FILENAME; internal use only. +If it is a symlink, remove the symlink. If file has multiple names, it continues to exist with the other names. */) (Lisp_Object filename) { Lisp_Object encoded_file; + filename = Fexpand_file_name (filename, Qnil); encoded_file = ENCODE_FILE (filename); if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT) @@ -2492,7 +2494,7 @@ internal_delete_file (Lisp_Object filename) { Lisp_Object tem; - tem = internal_condition_case_2 (Fdelete_file, filename, Qnil, + tem = internal_condition_case_2 (Fdelete_file_internal, filename, Qt, internal_delete_file_1); return NILP (tem); } From 1cc20535f8730f49cd5d012313c1eaf0627d7216 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 6 Aug 2023 09:08:56 -0700 Subject: [PATCH 2/4] Stop using printf %n MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/emacs.c (shut_down_emacs): Don’t use printf’s "%n" format. Android, MS-Windows, and OpenBSD don’t support it, and it’s easy enough to do its equivalent by hand. --- src/emacs.c | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 80a013b68df..5a036554a87 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2959,24 +2959,31 @@ shut_down_emacs (int sig, Lisp_Object stuff) reset_all_sys_modes (); if (sig && sig != SIGTERM) { - static char const fmt[] = "Fatal error %d: %n%s\n"; #ifdef HAVE_HAIKU if (haiku_debug_on_fatal_error) debugger ("Fatal error in Emacs"); #endif - char buf[max ((sizeof fmt - sizeof "%d%n%s\n" + /* Output a "Fatal error NUM: DESC\n" diagnostic with a single write, + but use multiple writes if the diagnosic is absurdly long + and likely couldn't be written atomically anyway. */ + static char const fmt[] = "Fatal error %d: "; + char buf[max ((sizeof fmt - sizeof "%d" + INT_STRLEN_BOUND (int) + 1), min (PIPE_BUF, MAX_ALLOCA))]; char const *sig_desc = safe_strsignal (sig); - int nlen; - int buflen = snprintf (buf, sizeof buf, fmt, sig, &nlen, sig_desc); - if (0 <= buflen && buflen < sizeof buf) - emacs_write (STDERR_FILENO, buf, buflen); + size_t sig_desclen = strlen (sig_desc); + int nlen = sprintf (buf, fmt, sig); + if (nlen + sig_desclen < sizeof buf - 1) + { + char *p = mempcpy (buf + nlen, sig_desc, sig_desclen); + *p++ = '\n'; + emacs_write (STDERR_FILENO, buf, p - buf); + } else { emacs_write (STDERR_FILENO, buf, nlen); - emacs_write (STDERR_FILENO, sig_desc, strlen (sig_desc)); - emacs_write (STDERR_FILENO, fmt + sizeof fmt - 2, 1); + emacs_write (STDERR_FILENO, sig_desc, sig_desclen); + emacs_write (STDERR_FILENO, "\n", 1); } } } From 4a973ed2bfb1da91a457a49a3a4089589fdf2d5f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 6 Aug 2023 20:10:16 +0200 Subject: [PATCH 3/4] ; Pacify new nadvice-tests byte-compiler warnings. --- test/lisp/emacs-lisp/nadvice-tests.el | 34 ++++++++++++++++----------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index f6bd5733ba3..7dfa936214a 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -65,8 +65,9 @@ (defun sm-test2 (x) (+ x 4)) (declare-function sm-test2 nil) (should (equal (sm-test2 6) 10)) - (defadvice sm-test2 (around sm-test activate) - ad-do-it (setq ad-return-value (* ad-return-value 5))) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test2 (around sm-test activate) + ad-do-it (setq ad-return-value (* ad-return-value 5)))) (should (equal (sm-test2 6) 50)) (ad-deactivate 'sm-test2) (should (equal (sm-test2 6) 10)) @@ -81,8 +82,9 @@ (should (equal (sm-test2 6) 20)) (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) - (defadvice sm-test4 (around wrap-with-toto activate) - ad-do-it (setq ad-return-value `(toto ,ad-return-value))) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test4 (around wrap-with-toto activate) + ad-do-it (setq ad-return-value `(toto ,ad-return-value)))) (defmacro sm-test4 (x) `(call-test4 ,x)) (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) (defmacro sm-test4 (x) `(call-testq ,x)) @@ -90,8 +92,9 @@ ;; This used to signal an error (bug#12858). (autoload 'sm-test6 "foo") - (defadvice sm-test6 (around test activate) - ad-do-it)) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test6 (around test activate) + ad-do-it))) (ert-deftest advice-tests-combination () "Combining old style and new style advices." @@ -100,8 +103,9 @@ (should (equal (sm-test5 6) 10)) (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) (should (equal (sm-test5 6) 50)) - (defadvice sm-test5 (around test activate) - ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test5 (around test activate) + ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))) (should (equal (sm-test5 5) 45.1)) (ad-deactivate 'sm-test5) (should (equal (sm-test5 6) 50)) @@ -174,18 +178,20 @@ function being an around advice." (ert-deftest advice-test-interactive () "Check handling of interactive spec." (defun sm-test8 (a) (interactive "p") a) - (defadvice sm-test8 (before adv1 activate) nil) - (defadvice sm-test8 (before adv2 activate) (interactive "P") nil) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test8 (before adv1 activate) nil) + (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)) (should (equal (interactive-form 'sm-test8) '(interactive "P")))) (ert-deftest advice-test-preactivate () (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) (defun sm-test9 (a) (interactive "p") a) (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) - (defadvice sm-test9 (before adv1 pre act protect compile) nil) - (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil)) - (defadvice sm-test9 (before adv2 pre act protect compile) - (interactive "P") nil) + (with-suppressed-warnings ((obsolete defadvice)) + (defadvice sm-test9 (before adv1 pre act protect compile) nil) + (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil)) + (defadvice sm-test9 (before adv2 pre act protect compile) + (interactive "P") nil)) (should (equal (interactive-form 'sm-test9) '(interactive "P")))) (ert-deftest advice-test-multiples () From 18e7bc87521e3c48b819cfe4a113f532ba905561 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 6 Aug 2023 20:39:10 +0200 Subject: [PATCH 4/4] Mark Emacs 21 compat aliases `lm-*-mark` obsolete * lisp/emacs-lisp/lisp-mnt.el (lm-section-mark, lm-code-mark) (lm-commentary-mark, lm-history-mark): Mark Emacs 21 compatibility aliases obsolete. Update all callers to use the new name. --- lisp/emacs-lisp/checkdoc.el | 10 +++++----- lisp/emacs-lisp/lisp-mnt.el | 26 +++++++++++++------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index c5e69d5ef56..aadd6480086 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2382,7 +2382,7 @@ Code:, and others referenced in the style guide." err (or ;; * Commentary Section - (if (and (not (lm-commentary-mark)) + (if (and (not (lm-commentary-start)) ;; No need for a commentary section in test files. (not (string-match (rx (or (seq (or "-test.el" "-tests.el") string-end) @@ -2419,10 +2419,10 @@ Code:, and others referenced in the style guide." (if (or (not checkdoc-force-history-flag) (file-exists-p "ChangeLog") (file-exists-p "../ChangeLog") - (lm-history-mark)) + (lm-history-start)) nil (progn - (goto-char (or (lm-commentary-mark) (point-min))) + (goto-char (or (lm-commentary-start) (point-min))) (cond ((re-search-forward "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc." @@ -2443,7 +2443,7 @@ Code:, and others referenced in the style guide." err (or ;; * Code section - (if (not (lm-code-mark)) + (if (not (lm-code-start)) (let ((cont t) pos) (goto-char (point-min)) @@ -2494,7 +2494,7 @@ Code:, and others referenced in the style guide." ;; Let's spellcheck the commentary section. This is the only ;; section that is easy to pick out, and it is also the most ;; visible section (with the finder). - (let ((cm (lm-commentary-mark))) + (let ((cm (lm-commentary-start))) (when cm (save-excursion (goto-char cm) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 1fa1297e787..67c9db29b7f 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -1,7 +1,6 @@ ;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*- -;; Copyright (C) 1992, 1994, 1997, 2000-2023 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2023 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: emacs-devel@gnu.org @@ -52,7 +51,7 @@ ;; ;; * Copyright line, which looks more or less like this: ;; -;; ;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; ;; Copyright (C) 1999-2001 Free Software Foundation, Inc. ;; ;; * A blank line ;; @@ -187,7 +186,6 @@ If the given section does not exist, return nil." (goto-char (point-min)) (if (re-search-forward (lm-get-header-re header 'section) nil t) (line-beginning-position (if after 2)))))) -(defalias 'lm-section-mark 'lm-section-start) (defun lm-section-end (header) "Return the buffer location of the end of a given section. @@ -230,12 +228,10 @@ a section." (defun lm-code-start () "Return the buffer location of the `Code' start marker." (lm-section-start "Code")) -(defalias 'lm-code-mark 'lm-code-start) (defun lm-commentary-start () "Return the buffer location of the `Commentary' start marker." (lm-section-start lm-commentary-header)) -(defalias 'lm-commentary-mark 'lm-commentary-start) (defun lm-commentary-end () "Return the buffer location of the `Commentary' section end." @@ -244,7 +240,6 @@ a section." (defun lm-history-start () "Return the buffer location of the `History' start marker." (lm-section-start lm-history-header)) -(defalias 'lm-history-mark 'lm-history-start) (defun lm-copyright-mark () "Return the buffer location of the `Copyright' line." @@ -258,7 +253,7 @@ a section." "Return the contents of the header named HEADER." (goto-char (point-min)) (let ((case-fold-search t)) - (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) + (when (and (re-search-forward (lm-get-header-re header) (lm-code-start) t) ;; RCS ident likes format "$identifier: data$" (looking-at (if (save-excursion @@ -402,7 +397,7 @@ ISO-DATE non-nil means return the date in ISO 8601 format." (when (progn (goto-char (point-min)) (re-search-forward "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " - (lm-code-mark) t)) + (lm-code-start) t)) (let ((dd (match-string 3)) (mm (match-string 2)) (yyyy (match-string 1))) @@ -420,7 +415,7 @@ ISO-DATE non-nil means return the date in ISO 8601 format." This can be found in an RCS or SCCS header." (lm-with-file file (or (lm-header "version") - (let ((header-max (lm-code-mark))) + (let ((header-max (lm-code-start))) (goto-char (point-min)) (cond ;; Look for an RCS header @@ -557,11 +552,11 @@ copyright notice is allowed." "`Keywords:' tag missing") ((not (lm-keywords-finder-p)) "`Keywords:' has no valid finder keywords (see `finder-known-keywords')") - ((not (lm-commentary-mark)) + ((not (lm-commentary-start)) "Can't find a `Commentary' section marker") - ((not (lm-history-mark)) + ((not (lm-history-start)) "Can't find a `History' section marker") - ((not (lm-code-mark)) + ((not (lm-code-start)) "Can't find a `Code' section marker") ((progn (goto-char (point-max)) @@ -631,6 +626,11 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer." (message "%s" (substitute-command-keys "Type \\[mail-send] to send bug report.")))) +(define-obsolete-function-alias 'lm-section-mark #'lm-section-start "30.1") +(define-obsolete-function-alias 'lm-code-mark #'lm-code-start "30.1") +(define-obsolete-function-alias 'lm-commentary-mark #'lm-commentary-start "30.1") +(define-obsolete-function-alias 'lm-history-mark #'lm-history-start "30.1") + (provide 'lisp-mnt) ;;; lisp-mnt.el ends here