procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-08-07 07:56:44 +08:00
commit 072a8a434e
6 changed files with 59 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lisp/emacs-lisp/checkdoc.el
View file

@ -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)

26
lisp/emacs-lisp/lisp-mnt.el
View file

@ -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 <esr@snark.thyrsus.com>
;; 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

4
lisp/files.el
View file

@ -6359,7 +6359,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.
@ -6372,7 +6372,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)))))

23
src/emacs.c
View file

@ -3076,24 +3076,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);
}
}
}

6
src/fileio.c
View file

@ -2566,12 +2566,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 (emacs_unlink (SSDATA (encoded_file)) != 0
@ -2596,7 +2598,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);
}

34
test/lisp/emacs-lisp/nadvice-tests.el
View file

@ -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 ()