From a4fb5811fab64b7437fa47239d5aae39ba3ed82a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 21 Jun 2021 11:44:58 +0200 Subject: * Do not attempt to write .elc files when not necessary (bug#49118) * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Do not attempt to write .elc files when not necessary. --- lisp/emacs-lisp/bytecomp.el | 134 ++++++++++++++++++++++---------------------- 1 file changed, 67 insertions(+), 67 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 472e0ba3ba3..3e65db42421 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2066,73 +2066,73 @@ See also `emacs-lisp-byte-compile-and-load'." (message "Compiling %s...done" filename)) (kill-buffer input-buffer) (with-current-buffer output-buffer - (goto-char (point-max)) - (insert "\n") ; aaah, unix. - (cond - ((null target-file) nil) ;We only wanted the warnings! - ((and (or (null byte-native-compiling) - (and byte-native-compiling byte+native-compile)) - (file-writable-p target-file) - ;; We attempt to create a temporary file in the - ;; target directory, so the target directory must be - ;; writable. - (file-writable-p - (file-name-directory - ;; Need to expand in case TARGET-FILE doesn't - ;; include a directory (Bug#45287). - (expand-file-name target-file)))) - ;; We must disable any code conversion here. - (let* ((coding-system-for-write 'no-conversion) - ;; Write to a tempfile so that if another Emacs - ;; process is trying to load target-file (eg in a - ;; parallel bootstrap), it does not risk getting a - ;; half-finished file. (Bug#4196) - (tempfile - (make-temp-file (when (file-writable-p target-file) - (expand-file-name target-file)))) - (default-modes (default-file-modes)) - (temp-modes (logand default-modes #o600)) - (desired-modes (logand default-modes #o666)) - (kill-emacs-hook - (cons (lambda () (ignore-errors - (delete-file tempfile))) - kill-emacs-hook))) - (unless (= temp-modes desired-modes) - (set-file-modes tempfile desired-modes 'nofollow)) - (write-region (point-min) (point-max) tempfile nil 1) - ;; This has the intentional side effect that any - ;; hard-links to target-file continue to - ;; point to the old file (this makes it possible - ;; for installed files to share disk space with - ;; the build tree, without causing problems when - ;; emacs-lisp files in the build tree are - ;; recompiled). Previously this was accomplished by - ;; deleting target-file before writing it. - (if byte-native-compiling - ;; Defer elc final renaming. - (setf byte-to-native-output-file - (cons tempfile target-file)) - (rename-file tempfile target-file t))) - (or noninteractive - byte-native-compiling - (message "Wrote %s" target-file))) - ((file-writable-p target-file) - ;; In case the target directory isn't writable (see e.g. Bug#44631), - ;; try writing to the output file directly. We must disable any - ;; code conversion here. - (let ((coding-system-for-write 'no-conversion)) - (with-file-modes (logand (default-file-modes) #o666) - (write-region (point-min) (point-max) target-file nil 1))) - (or noninteractive (message "Wrote %s" target-file))) - (t - ;; This is just to give a better error message than write-region - (let ((exists (file-exists-p target-file))) - (signal (if exists 'file-error 'file-missing) - (list "Opening output file" - (if exists - "Cannot overwrite file" - "Directory not writable or nonexistent") - target-file))))) + (when (and target-file + (or (not byte-native-compiling) + (and byte-native-compiling byte+native-compile))) + (goto-char (point-max)) + (insert "\n") ; aaah, unix. + (cond + ((and (file-writable-p target-file) + ;; We attempt to create a temporary file in the + ;; target directory, so the target directory must be + ;; writable. + (file-writable-p + (file-name-directory + ;; Need to expand in case TARGET-FILE doesn't + ;; include a directory (Bug#45287). + (expand-file-name target-file)))) + ;; We must disable any code conversion here. + (let* ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile + (make-temp-file (when (file-writable-p target-file) + (expand-file-name target-file)))) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes #o666)) + (kill-emacs-hook + (cons (lambda () (ignore-errors + (delete-file tempfile))) + kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes 'nofollow)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (if byte-native-compiling + ;; Defer elc final renaming. + (setf byte-to-native-output-file + (cons tempfile target-file)) + (rename-file tempfile target-file t))) + (or noninteractive + byte-native-compiling + (message "Wrote %s" target-file))) + ((file-writable-p target-file) + ;; In case the target directory isn't writable (see e.g. Bug#44631), + ;; try writing to the output file directly. We must disable any + ;; code conversion here. + (let ((coding-system-for-write 'no-conversion)) + (with-file-modes (logand (default-file-modes) #o666) + (write-region (point-min) (point-max) target-file nil 1))) + (or noninteractive (message "Wrote %s" target-file))) + (t + ;; This is just to give a better error message than write-region + (let ((exists (file-exists-p target-file))) + (signal (if exists 'file-error 'file-missing) + (list "Opening output file" + (if exists + "Cannot overwrite file" + "Directory not writable or nonexistent") + target-file)))))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) -- cgit v1.2.3 From 3b1d69efc32c8929281f38d55cef773e4680f2ad Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 21 Jun 2021 16:00:39 +0100 Subject: Fix shortdoc-add-function section creation * lisp/emacs-lisp/shortdoc.el (shortdoc-add-function): Use nconc to actually append a new section to the list of groups while avoiding a previous OBOE. Push a new group to the front of shortdoc--groups without copying it, just like define-short-documentation-group does. (buffer): Fix copypasta in unlock-buffer example. * test/lisp/emacs-lisp/shortdoc-tests.el (shortdoc-examples): Also check that :no-value forms demonstrate the right function. * doc/lispref/help.texi (Documentation Groups): Clarify that @dots in the define-short-documentation-group arglist refer to whole key-value pairs. Fix typo in :eg-result-string description. --- doc/lispref/help.texi | 4 ++-- lisp/emacs-lisp/shortdoc.el | 6 +++--- test/lisp/emacs-lisp/shortdoc-tests.el | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index dbbc34fb3a5..a788852de75 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -818,7 +818,7 @@ summaries of using those functions. The optional argument @var{functions} is a list whose elements are of the form: @lisp -(@var{func} @var{keyword} @var{val} @dots{}) +(@var{func} [@var{keyword} @var{val}]@dots{}) @end lisp The following keywords are recognized: @@ -914,7 +914,7 @@ eg. @click{} t @itemx :eg-result-string These two are the same as @code{:result} and @code{:eg-result}, respectively, but are inserted as is. This is useful when the result -is unreadable or should be on a particular form: +is unreadable or should be of a particular form: @example :no-eval (find-file "/tmp/foo") diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 16e83074764..4ff7cee623c 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -887,7 +887,7 @@ There can be any number of :example/:result elements." (lock-buffer :no-value (lock-buffer "/tmp/foo")) (unlock-buffer - :no-value (lock-buffer))) + :no-value (unlock-buffer))) (define-short-documentation-group overlay "Predicates" @@ -1283,11 +1283,11 @@ Example: (let ((glist (assq group shortdoc--groups))) (unless glist (setq glist (list group)) - (setq shortdoc--groups (append shortdoc--groups (list glist)))) + (push glist shortdoc--groups)) (let ((slist (member section glist))) (unless slist (setq slist (list section)) - (setq slist (append glist slist))) + (nconc glist slist)) (while (and (cdr slist) (not (stringp (cadr slist)))) (setq slist (cdr slist))) diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el index 050aac31659..3bb3185649b 100644 --- a/test/lisp/emacs-lisp/shortdoc-tests.el +++ b/test/lisp/emacs-lisp/shortdoc-tests.el @@ -34,7 +34,7 @@ (let ((fun (car item)) (props (cdr item))) (while props - (when (memq (car props) '(:eval :no-eval :no-eval*)) + (when (memq (car props) '(:eval :no-eval :no-eval* :no-value)) (let* ((example (cadr props)) (expr (cond ((consp example) example) -- cgit v1.2.3 From 3c0b50d1fc4ecbbaf782d92a5b145f7e1991fbc1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 22 Jun 2021 16:03:37 +0200 Subject: Make minor mode docstrings say what the mode "variable" is * lisp/emacs-lisp/easy-mmode.el (easy-mmode--arg-docstring): Add the mode variable (bug#36500). (easy-mmode--mode-docstring): (define-minor-mode): Pass in the getter. --- lisp/emacs-lisp/easy-mmode.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 0a6d4ec504e..cc150117120 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -92,10 +92,14 @@ If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. +To check whether the minor mode is enabled in the current buffer, +evaluate `%S'. + The mode's hook is called both when the mode is enabled and when it is disabled.") -(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym) +(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym + getter) (let ((doc (or doc (format "Toggle %s on or off. \\{%s}" mode-pretty-name keymap-sym)))) @@ -104,7 +108,8 @@ it is disabled.") (let* ((fill-prefix nil) (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column)) (fill-column (if (integerp docs-fc) docs-fc 65)) - (argdoc (format easy-mmode--arg-docstring mode-pretty-name)) + (argdoc (format easy-mmode--arg-docstring mode-pretty-name + getter)) (filled (if (fboundp 'fill-region) (with-temp-buffer (insert argdoc) @@ -308,7 +313,8 @@ or call the function `%s'.")))) ,(funcall warnwrap `(defun ,modefun (&optional arg ,@extra-args) - ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) + ,(easy-mmode--mode-docstring doc pretty-name keymap-sym + getter) ,(when interactive ;; Use `toggle' rather than (if ,mode 0 1) so that using ;; repeat-command still does the toggling correctly. -- cgit v1.2.3 From f85ee6d5c7ec23ee94573753275f9089215be7fd Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Jun 2021 16:59:42 +0200 Subject: Clarify the help in the package buffers * lisp/emacs-lisp/package.el (package--quick-help-keys): Clarify marking help (bug#40457). --- lisp/emacs-lisp/package.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5df9b53657b..a0f1ab0ed67 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3374,7 +3374,8 @@ If optional arg BUTTON is non-nil, describe its associated package." (forward-line 1))))) (defvar package--quick-help-keys - '(("install," "delete," "unmark," ("execute" . 1)) + '((("mark for installation," . 9) + ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1)) ("next," "previous") ("Hide-package," "(-toggle-hidden") ("g-refresh-contents," "/-filter," "help"))) -- cgit v1.2.3 From bf21aba533864bf0179b2e76f4bdc2e7c6cce726 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Jun 2021 20:13:08 +0200 Subject: Fix printing of defclass documentation slots again * lisp/emacs-lisp/cl-extra.el (cl--describe-class-slots): Fix printing defclass slots, and retain printing of defstruct slots (bug#30998 and bug#46662). --- lisp/emacs-lisp/cl-extra.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index eabba27d229..13036544825 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -897,8 +897,14 @@ Outputs to the current buffer." (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (cl-prin1-to-string (cl--slot-descriptor-type slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc (plist-get (cl--slot-descriptor-props slot) - :documentation))) + (let ((doc + ;; The props are an alist in a `defclass', + ;; but a plist when describing a `cl-defstruct'. + (if (consp (car (cl--slot-descriptor-props slot))) + (alist-get :documentation + (cl--slot-descriptor-props slot)) + (plist-get (cl--slot-descriptor-props slot) + :documentation)))) (if (not doc) "" (setq has-doc t) (substitute-command-keys doc))))) -- cgit v1.2.3 From b188861af403aa0da0fefc3a8bf73c9380297e4e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Jun 2021 20:24:43 +0200 Subject: Attempt to make defclass documentation more legible * lisp/emacs-lisp/cl-extra.el (cl--print-table): Attempt to make defclass documentation more readable (bug#30998). (cl--describe-class-slots): Ditto. --- lisp/emacs-lisp/cl-extra.el | 11 +++++++---- lisp/emacs-lisp/subr-x.el | 1 + 2 files changed, 8 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 13036544825..c30349de6bb 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -847,7 +847,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. "\n"))) "\n")) -(defun cl--print-table (header rows) +(defun cl--print-table (header rows &optional last-slot-on-next-line) ;; FIXME: Isn't this functionality already implemented elsewhere? (let ((cols (apply #'vector (mapcar #'string-width header))) (col-space 2)) @@ -877,7 +877,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'. header)) "\n") (dolist (row rows) - (insert (apply #'format format row) "\n")))))) + (insert (apply #'format format row) "\n") + (when last-slot-on-next-line + (dolist (line (string-lines (car (last row)))) + (insert " " line "\n")) + (insert "\n"))))))) (defun cl--describe-class-slots (class) "Print help description for the slots in CLASS. @@ -909,8 +913,7 @@ Outputs to the current buffer." (setq has-doc t) (substitute-command-keys doc))))) slots))) - (cl--print-table `("Name" "Type" "Default" . ,(if has-doc '("Doc"))) - slots-strings)) + (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)) (insert "\n") (when (> (length cslots) 0) (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 1c13c398dde..468d124c0e2 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -317,6 +317,7 @@ than this function." (end (substring string (- (length string) length))) (t (substring string 0 length))))) +;;;###autoload (defun string-lines (string &optional omit-nulls) "Split STRING into a list of lines. If OMIT-NULLS, empty lines will be removed from the results." -- cgit v1.2.3 From 1283e1db9b7750a90472e7d557fdd75fcaff6446 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 24 Jun 2021 20:48:41 +0200 Subject: Don't call ERT explainer on error * lisp/emacs-lisp/ert.el (ert--expand-should-1): If the predicate form signals an error, don't call an explainer because the arguments passed (the error and error argument, respectively) do not make any sense to the explainer at all. --- lisp/emacs-lisp/ert.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 6793b374eea..7de07bd6f53 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -313,12 +313,13 @@ It should only be stopped when ran from inside ert--run-test-internal." (list :form `(,,fn ,@,args)) (unless (eql ,value ',default-value) (list :value ,value)) - (let ((-explainer- - (and (symbolp ',fn-name) - (get ',fn-name 'ert-explainer)))) - (when -explainer- - (list :explanation - (apply -explainer- ,args))))) + (unless (eql ,value ',default-value) + (let ((-explainer- + (and (symbolp ',fn-name) + (get ',fn-name 'ert-explainer)))) + (when -explainer- + (list :explanation + (apply -explainer- ,args)))))) value) ,value)))))))) -- cgit v1.2.3 From 3788d2237d4c65b67b95e33d1aca8d8b41780429 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Jun 2021 17:32:20 -0400 Subject: * lisp/emacs-lisp/cl-preloaded.el: Fix the format of props in slot-descs (cl--plist-remove): Remove. (cl--plist-to-alist): New function. (cl-struct-define): Use it to convert slots's properties to the format expected by `cl-slot-descriptor`. * lisp/emacs-lisp/cl-extra.el (cl--describe-class-slots): Revert last changes, not needed any more. --- lisp/emacs-lisp/cl-extra.el | 10 ++-------- lisp/emacs-lisp/cl-preloaded.el | 21 +++++++++++---------- 2 files changed, 13 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c30349de6bb..3840d13ecff 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -901,14 +901,8 @@ Outputs to the current buffer." (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (cl-prin1-to-string (cl--slot-descriptor-type slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc - ;; The props are an alist in a `defclass', - ;; but a plist when describing a `cl-defstruct'. - (if (consp (car (cl--slot-descriptor-props slot))) - (alist-get :documentation - (cl--slot-descriptor-props slot)) - (plist-get (cl--slot-descriptor-props slot) - :documentation)))) + (let ((doc (alist-get :documentation + (cl--slot-descriptor-props slot)))) (if (not doc) "" (setq has-doc t) (substitute-command-keys doc))))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7365e23186a..ef60b266f9e 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -124,12 +124,11 @@ supertypes from the most specific to least specific.") (get name 'cl-struct-print)) (cl--find-class name))))) -(defun cl--plist-remove (plist member) - (cond - ((null plist) nil) - ((null member) plist) - ((eq plist member) (cddr plist)) - (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member))))) +(defun cl--plist-to-alist (plist) + (let ((res '())) + (while plist + (push (cons (pop plist) (pop plist)) res)) + (nreverse res))) (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage @@ -164,12 +163,14 @@ supertypes from the most specific to least specific.") (i 0) (offset (if type 0 1))) (dolist (slot slots) - (let* ((props (cddr slot)) - (typep (plist-member props :type)) - (type (if typep (cadr typep) t))) + (let* ((props (cl--plist-to-alist (cddr slot))) + (typep (assq :type props)) + (type (if (null typep) t + (setq props (delq typep props)) + (cdr typep)))) (aset v i (cl--make-slot-desc (car slot) (nth 1 slot) - type (cl--plist-remove props typep)))) + type props))) (puthash (car slot) (+ i offset) index-table) (cl-incf i)) v)) -- cgit v1.2.3 From 9e8d8e1a037b0f8d4f06dfd384c27a894f442de7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Jun 2021 17:16:28 +0200 Subject: Make (find-face-definition 'default) work more reliably * lisp/emacs-lisp/find-func.el (find-function--defface): New function (bug#30230). (find-function-regexp-alist): Use it to skip past definitions inside comments and strings. --- lisp/emacs-lisp/find-func.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 58876a45e19..7bc3e6b25ff 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -123,10 +123,18 @@ should insert the feature name." :group 'xref :version "25.1") +(defun find-function--defface (symbol) + (catch 'found + (while (re-search-forward (format find-face-regexp symbol) nil t) + (unless (ppss-comment-or-string-start + (save-excursion (syntax-ppss (match-beginning 0)))) + ;; We're not in a comment or a string. + (throw 'found t))))) + (defvar find-function-regexp-alist '((nil . find-function-regexp) (defvar . find-variable-regexp) - (defface . find-face-regexp) + (defface . find-function--defface) (feature . find-feature-regexp) (defalias . find-alias-regexp)) "Alist mapping definition types into regexp variables. -- cgit v1.2.3 From 52528d6a162630a57ec0dd182295b4ce2c4c228d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 25 Jun 2021 19:43:04 +0200 Subject: Print newlines as \n instead of \12 in ERT results This makes test errors unquestionably more readable. The change also makes FF print as \f; other controls still use octal escapes. * lisp/emacs-lisp/ert.el (ert--pp-with-indentation-and-newline): Run `pp` with `pp-escape-newlines` set to `t`. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7de07bd6f53..50b45092ca8 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1301,7 +1301,7 @@ empty string." "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." (let ((begin (point)) - (pp-escape-newlines nil) + (pp-escape-newlines t) (print-escape-control-characters t)) (pp object (current-buffer)) (unless (bolp) (insert "\n")) -- cgit v1.2.3 From 73663d14cfb3923dc57fab0043f7b1aa3a488407 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 Jun 2021 12:20:11 -0400 Subject: * lisp/emacs-lisp/cl-macs.el: Fix test regression (cl--alist-to-plist): New function. (cl-struct-slot-info): Use it. --- lisp/emacs-lisp/cl-macs.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a59d42e673c..cff43689405 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3276,6 +3276,13 @@ STRUCT-TYPE is a symbol naming a struct type. Return `record', (declare (side-effect-free t) (pure t)) (cl--struct-class-type (cl--struct-get-class struct-type))) +(defun cl--alist-to-plist (alist) + (let ((res '())) + (dolist (x alist) + (push (car x) res) + (push (cdr x) res)) + (nreverse res))) + (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a @@ -3293,7 +3300,7 @@ slots skipped by :initial-offset may appear in the list." ,(cl--slot-descriptor-initform slot) ,@(if (not (eq (cl--slot-descriptor-type slot) t)) `(:type ,(cl--slot-descriptor-type slot))) - ,@(cl--slot-descriptor-props slot)) + ,@(cl--alist-to-plist (cl--slot-descriptor-props slot))) descs))) (nreverse descs))) -- cgit v1.2.3 From b8f9e58ef72402e69a1f0960816184d52e5d2d29 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 Jun 2021 12:29:52 -0400 Subject: * lisp/minibuffer.el (completion-in-region--single-word): Simplify Remove redundant args `collection` and `predicate` which were always equal to `minibuffer-completion-table` and `minibuffer-completion-predicate` anyway. (minibuffer-complete-word): * lisp/emacs-lisp/crm.el (crm-complete-word): Simplify accordingly. --- lisp/emacs-lisp/crm.el | 3 +-- lisp/minibuffer.el | 15 +++++---------- 2 files changed, 6 insertions(+), 12 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index e106815817e..d24ea355a51 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -183,8 +183,7 @@ Return t if the current element is now a valid match; otherwise return nil." Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) (crm--completion-command beg end - (completion-in-region--single-word - beg end minibuffer-completion-table minibuffer-completion-predicate))) + (completion-in-region--single-word beg end))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 157ed617b05..71a2177c9b1 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1790,17 +1790,12 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) (completion-in-region--single-word - (minibuffer--completion-prompt-end) (point-max) - minibuffer-completion-table minibuffer-completion-predicate)) - -(defun completion-in-region--single-word (beg end collection - &optional predicate) - (let ((minibuffer-completion-table collection) - (minibuffer-completion-predicate predicate)) - (pcase (completion--do-completion beg end - #'completion--try-word-completion) + (minibuffer--completion-prompt-end) (point-max))) + +(defun completion-in-region--single-word (beg end) + (pcase (completion--do-completion beg end #'completion--try-word-completion) (#b000 nil) - (_ t)))) + (_ t))) (defface completions-annotations '((t :inherit (italic shadow))) "Face to use for annotations in the *Completions* buffer.") -- cgit v1.2.3 From 4f2765f6f1a2cc6da408e3c5ff99ea5f8756bad4 Mon Sep 17 00:00:00 2001 From: Colin Woodbury Date: Wed, 30 Jun 2021 14:07:29 +0200 Subject: Add new function file-name-with-extension * doc/lispref/files.texi (File Name Components): Document it. * lisp/emacs-lisp/shortdoc.el (file-name): Ditto. * lisp/files.el (file-name-with-extension): New function. --- doc/lispref/files.texi | 19 +++++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/shortdoc.el | 3 +++ lisp/files.el | 21 +++++++++++++++++++++ test/lisp/files-tests.el | 18 ++++++++++++++++++ 5 files changed, 66 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 2033177fbb0..dd9ce2cd011 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2129,6 +2129,25 @@ the period that delimits the extension, and if @var{filename} has no extension, the value is @code{""}. @end defun +@defun file-name-with-extension filename extension +This function returns @var{filename} with its extension set to +@var{extension}. A single leading dot in the @var{extension} will be +stripped if there is one. For example: + +@example +(file-name-with-extension "file" "el") + @result{} "file.el" +(file-name-with-extension "file" ".el") + @result{} "file.el" +(file-name-with-extension "file.c" "el") + @result{} "file.el" +@end example + +Note that this function will error if @var{filename} or +@var{extension} are empty, or if the @var{filename} is shaped like a +directory (i.e. if @code{directory-name-p} returns non-@code{nil}). +@end defun + @defun file-name-sans-extension filename This function returns @var{filename} minus its extension, if any. The version/backup part, if present, is only removed if the file has an diff --git a/etc/NEWS b/etc/NEWS index b9a9369049a..6345992dfe1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3058,6 +3058,11 @@ been added, and takes a callback to handle the return status. --- ** 'ascii' is now a coding system alias for 'us-ascii'. ++++ +** New function 'file-name-with-extension'. +This function allows a canonical way to set/replace the extension of a +filename string. + +++ ** New function 'file-backup-file-names'. This function returns the list of file names of all the backup files diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4ff7cee623c..4df404015a0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -268,6 +268,9 @@ There can be any number of :example/:result elements." :eval (file-name-extension "/tmp/foo.txt")) (file-name-sans-extension :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-with-extension + :eval (file-name-with-extension "foo.txt" "bin") + :eval (file-name-with-extension "foo" "bin")) (file-name-base :eval (file-name-base "/tmp/foo.txt")) (file-relative-name diff --git a/lisp/files.el b/lisp/files.el index 04db0faffd0..39f4ca65b1d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4894,6 +4894,27 @@ extension, the value is \"\"." (if period ""))))) +(defun file-name-with-extension (filename extension) + "Set the EXTENSION of a FILENAME. +The extension (in a file name) is the part that begins with the last \".\". + +Trims a leading dot from the EXTENSION so that either \"foo\" or +\".foo\" can be given. + +Errors if the filename or extension are empty, or if the given +filename has the format of a directory. + +See also `file-name-sans-extension'." + (let ((extn (string-trim-left extension "[.]"))) + (cond ((string-empty-p filename) + (error "Empty filename: %s" filename)) + ((string-empty-p extn) + (error "Malformed extension: %s" extension)) + ((directory-name-p filename) + (error "Filename is a directory: %s" filename)) + (t + (concat (file-name-sans-extension filename) "." extn))))) + (defun file-name-base (&optional filename) "Return the base name of the FILENAME: no directory, no extension." (declare (advertised-calling-convention (filename) "27.1")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index dc96dff6398..257cbc2d329 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1478,5 +1478,23 @@ The door of all subtleties! (buffer-substring (point-min) (point-max)) nil nil))))) +(ert-deftest files-tests-file-name-with-extension-good () + "Test that `file-name-with-extension' succeeds with reasonable input." + (should (string= (file-name-with-extension "Jack" "css") "Jack.css")) + (should (string= (file-name-with-extension "Jack" ".css") "Jack.css")) + (should (string= (file-name-with-extension "Jack.scss" "css") "Jack.css")) + (should (string= (file-name-with-extension "/path/to/Jack.md" "org") "/path/to/Jack.org"))) + +(ert-deftest files-tests-file-name-with-extension-bad () + "Test that `file-name-with-extension' fails on malformed input." + (should-error (file-name-with-extension nil nil)) + (should-error (file-name-with-extension "Jack" nil)) + (should-error (file-name-with-extension nil "css")) + (should-error (file-name-with-extension "" "")) + (should-error (file-name-with-extension "" "css")) + (should-error (file-name-with-extension "Jack" "")) + (should-error (file-name-with-extension "Jack" ".")) + (should-error (file-name-with-extension "/is/a/directory/" "css"))) + (provide 'files-tests) ;;; files-tests.el ends here -- cgit v1.2.3 From 46a66c6248be20c7c3ef7f57a8f25af39b975eb6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 30 Jun 2021 15:31:26 +0200 Subject: Make the minor mode doc strings say that they're minor modes * lisp/emacs-lisp/easy-mmode.el (easy-mmode--arg-docstring): Mention that this is a minor mode (bug#20462). --- lisp/emacs-lisp/easy-mmode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index cc150117120..3a00fdb454d 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -84,9 +84,9 @@ replacing its case-insensitive matches with the literal string in LIGHTER." (defconst easy-mmode--arg-docstring " -If called interactively, toggle `%s'. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `%s' +mode. If the prefix argument is positive, enable the mode, and +if it is zero or negative, disable the mode. If called from Lisp, toggle the mode if ARG is `toggle'. Enable the mode if ARG is nil, omitted, or is a positive number. -- cgit v1.2.3 From 1439e9bfadb2ba66f55530daab1f9886c7a98c02 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 30 Jun 2021 17:00:13 +0100 Subject: Adjust docstring of lisp-mode (bug#49278) * lisp/emacs-lisp/lisp-mode.el (lisp-mode): Mention that this mode is primarily for Common Lisp. --- lisp/emacs-lisp/lisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 59325d647d8..51fb88502ab 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -765,7 +765,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"])) (define-derived-mode lisp-mode lisp-data-mode "Lisp" - "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. + "Major mode for editing programs in Common Lisp and other similar Lisps. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. -- cgit v1.2.3 From 0e3668b23323de130d6d8cda70c4669a4b7aa2f3 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sat, 22 May 2021 21:58:53 +0200 Subject: * lisp/emacs-lisp/lisp-mnt.el (lm-crack-address): Right-trim name. The addresses might be aligned in which case we have to trim the extra whitespace at the end of the names. --- lisp/emacs-lisp/lisp-mnt.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 73a33a553fb..11a04400877 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -360,10 +360,10 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" "Split up an email address X into full name and real email address. The value is a cons of the form (FULLNAME . ADDRESS)." (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) - (cons (match-string 1 x) + (cons (string-trim-right (match-string 1 x)) (match-string 2 x))) ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) - (cons (match-string 2 x) + (cons (string-trim-right (match-string 2 x)) (match-string 1 x))) ((string-match "\\S-+@\\S-+" x) (cons nil x)) -- cgit v1.2.3 From 3cfc5532021357ef2e1284323e6936fafce484e5 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Mon, 3 May 2021 23:22:47 +0200 Subject: Add new function lm-maintainers (bug#48592) * doc/lispref/tips.texi (Library Headers): Improve wording. * lisp/emacs-lisp/lisp-mnt.el (lm-maintainers): New function. (lm-maintainer): Make obsolete in favor of lm-maintainer. (lm-verify): Use lm-maintainers. (lm-report-bug): Use lm-maintainers. --- doc/lispref/tips.texi | 6 +++--- lisp/emacs-lisp/lisp-mnt.el | 22 +++++++++++++++------- 2 files changed, 18 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 36c68ee5ced..54cafffab38 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1034,7 +1034,7 @@ the conventional possibilities for @var{header-name}: @table @samp @item Author -This line states the name and email address of at least the principal +This header states the name and email address of at least the principal author of the library. If there are multiple authors, list them on continuation lines led by @code{;;} and a tab or at least two spaces. We recommend including a contact email address, of the form @@ -1053,8 +1053,8 @@ This header has the same format as the Author header. It lists the person(s) who currently maintain(s) the file (respond to bug reports, etc.). -If there is no maintainer line, the person(s) in the Author field -is/are presumed to be the maintainers. Some files in Emacs use +If there is no Maintainer header, the person(s) in the Author header +is/are presumed to be the maintainer(s). Some files in Emacs use @samp{emacs-devel@@gnu.org} for the maintainer, which means the author is no longer responsible for the file, and that it is maintained as part of Emacs. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 11a04400877..83da495edf0 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -378,14 +378,22 @@ the cdr is an email address." (let ((authorlist (lm-header-multiline "author"))) (mapcar #'lm-crack-address authorlist)))) +(defun lm-maintainers (&optional file) + "Return the maintainer list of file FILE, or current buffer if FILE is nil. +If the maintainers are unspecified, then return the authors. +Each element of the list is a cons; the car is the full name, +the cdr is an email address." + (lm-with-file file + (mapcar #'lm-crack-address + (or (lm-header-multiline "maintainer") + (lm-header-multiline "author"))))) + (defun lm-maintainer (&optional file) "Return the maintainer of file FILE, or current buffer if FILE is nil. +If the maintainer is unspecified, then return the author. The return value has the form (NAME . ADDRESS)." - (lm-with-file file - (let ((maint (lm-header "maintainer"))) - (if maint - (lm-crack-address maint) - (car (lm-authors)))))) + (declare (obsolete lm-maintainers "28.1")) + (car (lm-maintainers file))) (defun lm-creation-date (&optional file) "Return the created date given in file FILE, or current buffer if FILE is nil." @@ -545,7 +553,7 @@ copyright notice is allowed." "Can't find package name") ((not (lm-authors)) "`Author:' tag missing") - ((not (lm-maintainer)) + ((not (lm-maintainers)) "`Maintainer:' tag missing") ((not (lm-summary)) "Can't find the one-line summary description") @@ -613,7 +621,7 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer." (interactive "sBug Subject: ") (require 'emacsbug) (let ((package (lm-get-package-name)) - (addr (lm-maintainer)) + (addr (car (lm-maintainers))) (version (lm-version))) (compose-mail (if addr (concat (car addr) " <" (cdr addr) ">") -- cgit v1.2.3 From 527bab054f285cde9d7f792c932c40ddcce74590 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 1 Jul 2021 13:43:44 +0200 Subject: Handle test environment variables * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): Check also for EMACS_EMBA_CI. * test/README (SELECTOR): Mention EMACS_TEST_VERBOSE. * test/infra/gitlab-ci.yml (variables): Set EMACS_TEST_VERBOSE. --- lisp/emacs-lisp/ert.el | 6 +++--- test/README | 5 +++++ test/infra/gitlab-ci.yml | 1 + 3 files changed, 9 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 50b45092ca8..92acfe7246f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1552,7 +1552,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (when badtests (message "%d files did not finish:" (length badtests)) (mapc (lambda (l) (message " %s" l)) badtests) - (if (getenv "EMACS_HYDRA_CI") + (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) (with-temp-buffer (dolist (f badtests) (erase-buffer) @@ -1568,8 +1568,8 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (setq tests (sort tests (lambda (x y) (> (car x) (car y))))) (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil)) (message "%s" (mapconcat #'cdr tests "\n"))) - ;; More details on hydra, where the logs are harder to get to. - (when (and (getenv "EMACS_HYDRA_CI") + ;; More details on hydra and emba, where the logs are harder to get to. + (when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) (not (zerop (+ nunexpected nskipped)))) (message "\nDETAILS") (message "-------") diff --git a/test/README b/test/README index 0c8d5a409be..97611cf8644 100644 --- a/test/README +++ b/test/README @@ -105,6 +105,11 @@ debugging. To do that, use make TEST_INTERACTIVE=yes ... +By default, ERT test failure summaries are quite brief in batch +mode--only the names of the failed tests are listed. If the +$EMACS_TEST_VERBOSE environment variable is set, the failure summaries +will also include the data from the failing test. + Some of the tests require a remote temporary directory (autorevert-tests.el, filenotify-tests.el, shadowfile-tests.el and tramp-tests.el). Per default, a mock-up connection method is used diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index fa10fa67611..6876a8b11d8 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,6 +44,7 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 + EMACS_TEST_VERBOSE: 1 # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 # DOCKER_TLS_CERTDIR: "/certs" -- cgit v1.2.3