diff options
author | Yuuki Harano <masm+github@masm11.me> | 2020-12-14 01:52:10 +0900 |
---|---|---|
committer | Yuuki Harano <masm+github@masm11.me> | 2020-12-14 01:52:10 +0900 |
commit | 3e30047ce3a81dd0879973012abbf570d3215dfd (patch) | |
tree | c7c10e82f2ff37705356a0c25b98d92c603c7983 /lisp/emacs-lisp | |
parent | aea5dbec2514811fb2e1cc44b2347a976a5b7de8 (diff) | |
parent | fe50a8b9ba79b4ac14a3a352d8bf84eaee4f2122 (diff) | |
download | emacs-3e30047ce3a81dd0879973012abbf570d3215dfd.tar.gz emacs-3e30047ce3a81dd0879973012abbf570d3215dfd.tar.bz2 emacs-3e30047ce3a81dd0879973012abbf570d3215dfd.zip |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 131 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 14 | ||||
-rw-r--r-- | lisp/emacs-lisp/eldoc.el | 1 | ||||
-rw-r--r-- | lisp/emacs-lisp/elint.el | 10 | ||||
-rw-r--r-- | lisp/emacs-lisp/ert.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 8 | ||||
-rw-r--r-- | lisp/emacs-lisp/memory-report.el | 303 | ||||
-rw-r--r-- | lisp/emacs-lisp/package.el | 16 | ||||
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 3 | ||||
-rw-r--r-- | lisp/emacs-lisp/thunk.el | 2 |
10 files changed, 416 insertions, 74 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0acd5276977..e23bb9f5e6e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)" ;; Eg is_elc in Fload. :type 'regexp) -(defcustom byte-compile-dest-file-function nil +(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file "Function for the function `byte-compile-dest-file' to call. It should take one argument, the name of an Emacs Lisp source file name, and return the name of the compiled file. @@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension \".el\"), replaces the matching part (and anything after it) with \".elc\"; otherwise adds \".elc\"." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc"))))) -) + (funcall (or byte-compile-dest-file-function + #'byte-compile--default-dest-file) + filename))) + +(defun byte-compile--default-dest-file (filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") @@ -1809,24 +1811,23 @@ If compilation is needed, this functions returns the result of (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults (filename (expand-file-name filename))) - (if (if (file-exists-p dest) - ;; File was already compiled - ;; Compile if forced to, or filename newer - (or force - (file-newer-than-file-p filename dest)) - (and arg - (or (eq 0 arg) - (y-or-n-p (concat "Compile " - filename "? "))))) - (progn - (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." filename)) - (byte-compile-file filename) - (when load - (load (if (file-exists-p dest) dest filename)))) + (prog1 + (if (if (and dest (file-exists-p dest)) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or force + (file-newer-than-file-p filename dest)) + (and arg + (or (eq 0 arg) + (y-or-n-p (concat "Compile " + filename "? "))))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." filename)) + (byte-compile-file filename)) + 'no-byte-compile) (when load - (load (if (file-exists-p dest) dest filename))) - 'no-byte-compile))) + (load (if (and dest (file-exists-p dest)) dest filename)))))) (defun byte-compile--load-dynvars (file) (and file (not (equal file "")) @@ -1936,7 +1937,7 @@ See also `emacs-lisp-byte-compile-and-load'." ;; (message "%s not compiled because of `no-byte-compile: %s'" ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) - (when (file-exists-p target-file) + (when (and target-file (file-exists-p target-file)) (message "%s deleted because of `no-byte-compile: %s'" (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) @@ -1960,36 +1961,50 @@ See also `emacs-lisp-byte-compile-and-load'." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) - ;; We must disable any code conversion here. - (progn - (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 (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. - (rename-file tempfile target-file t)) - (or noninteractive (message "Wrote %s" target-file))) + (cond + ((null target-file) nil) ;We only wanted the warnings! + ((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 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 (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. + (rename-file tempfile target-file t)) + (or noninteractive (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) @@ -1997,7 +2012,7 @@ See also `emacs-lisp-byte-compile-and-load'." (if exists "Cannot overwrite file" "Directory not writable or nonexistent") - target-file)))) + target-file))))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 02da07daaf4..b37b05b9a3a 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -410,8 +410,18 @@ the specializer used will be the one returned by BODY." ;;;###autoload (defmacro cl-defmethod (name args &rest body) "Define a new method for generic function NAME. -I.e. it defines the implementation of NAME to use for invocations where the -values of the dispatch arguments match the specified TYPEs. +This it defines an implementation of NAME to use for invocations +of specific types of arguments. + +ARGS is a list of dispatch arguments (see `cl-defun'), but where +each variable element is either just a single variable name VAR, +or a list on the form (VAR TYPE). + +For instance: + + (cl-defmethod foo (bar (format-string string) &optional zot) + (format format-string bar)) + The dispatch arguments have to be among the mandatory arguments, and all methods of NAME have to use the same set of arguments for dispatch. Each dispatch argument and TYPE are specified in ARGS where the corresponding diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index d81060ef165..6a976841038 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -467,7 +467,6 @@ This holds the results of the last documentation request." (defun eldoc--format-doc-buffer (docs) "Ensure DOCS are displayed in an *eldoc* buffer." - (interactive (list t)) (with-current-buffer (if (buffer-live-p eldoc--doc-buffer) eldoc--doc-buffer (setq eldoc--doc-buffer diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index ef97c8279d7..79b72ff969f 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -558,7 +558,8 @@ Return nil if there are no more forms, t otherwise." (when . elint-check-conditional-form) (unless . elint-check-conditional-form) (and . elint-check-conditional-form) - (or . elint-check-conditional-form)) + (or . elint-check-conditional-form) + (require . elint-require-form)) "Functions to call when some special form should be linted.") (defun elint-form (form env &optional nohandler) @@ -953,6 +954,13 @@ Does basic handling of `featurep' tests." (elint-form form env t)))) env) +(defun elint-require-form (form _env) + "Load `require'd files." + (pcase form + (`(require ',x) + (require x))) + nil) + ;;; ;;; Message functions ;;; diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 5f29c2665a3..25237feae2a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -274,7 +274,7 @@ DATA is displayed to the user and should state the reason for skipping." It should only be stopped when ran from inside ert--run-test-internal." (when (and (not (symbolp debugger)) ; only run on anonymous debugger (memq error-symbol '(ert-test-failed ert-test-skipped))) - (funcall debugger 'error data))) + (funcall debugger 'error (list error-symbol data)))) (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 081ef8d441a..e477ef17000 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -38,7 +38,7 @@ (define-abbrev-table 'lisp-mode-abbrev-table () "Abbrev table for Lisp mode.") -(defvar lisp--mode-syntax-table +(defvar lisp-data-mode-syntax-table (let ((table (make-syntax-table)) (i 0)) (while (< i ?0) @@ -77,11 +77,13 @@ (modify-syntax-entry ?\\ "\\ " table) (modify-syntax-entry ?\( "() " table) (modify-syntax-entry ?\) ")( " table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) table) "Parent syntax table used in Lisp modes.") (defvar lisp-mode-syntax-table - (let ((table (make-syntax-table lisp--mode-syntax-table))) + (let ((table (make-syntax-table lisp-data-mode-syntax-table))) (modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\] "_ " table) (modify-syntax-entry ?# "' 14" table) @@ -669,7 +671,7 @@ font-lock keywords will not be case sensitive." (define-derived-mode lisp-data-mode prog-mode "Lisp-Data" "Major mode for buffers holding data written in Lisp syntax." :group 'lisp - (lisp-mode-variables t t nil) + (lisp-mode-variables nil t nil) (setq-local electric-quote-string t) (setq imenu-case-fold-search nil)) diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el new file mode 100644 index 00000000000..04ae87d9ea0 --- /dev/null +++ b/lisp/emacs-lisp/memory-report.el @@ -0,0 +1,303 @@ +;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Keywords: lisp, help + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Todo (possibly): Font cache, regexp cache, bidi cache, various +;; buffer caches (newline cache, free_region_cache, etc), composition +;; cache, face cache. + +;;; Code: + +(require 'seq) +(require 'subr-x) +(eval-when-compile (require 'cl-lib)) + +(defvar memory-report--type-size (make-hash-table)) + +;;;###autoload +(defun memory-report () + "Generate a report of how Emacs is using memory. + +This report is approximate, and will commonly over-count memory +usage by variables, because shared data structures will usually +by counted more than once." + (interactive) + (pop-to-buffer "*Memory Report*") + (special-mode) + (button-mode 1) + (setq truncate-lines t) + (message "Gathering data...") + (let ((reports (append (memory-report--garbage-collect) + (memory-report--image-cache) + (memory-report--buffers) + (memory-report--largest-variables))) + (inhibit-read-only t) + summaries details) + (message "Gathering data...done") + (erase-buffer) + (insert (propertize "Estimated Emacs Memory Usage\n\n" 'face 'bold)) + (dolist (report reports) + (if (listp report) + (push report summaries) + (push report details))) + (dolist (summary (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + summaries)) + (insert (format "%s %s\n" + (memory-report--format (cdr summary)) + (car summary)))) + (insert "\n") + (dolist (detail (nreverse details)) + (insert detail "\n"))) + (goto-char (point-min))) + +(defun memory-report-object-size (object) + "Return the size of OBJECT in bytes." + (unless memory-report--type-size + (memory-report--garbage-collect)) + (memory-report--object-size (make-hash-table :test #'eq) object)) + +(defun memory-report--size (type) + (or (gethash type memory-report--type-size) + (gethash 'object memory-report--type-size))) + +(defun memory-report--set-size (elems) + (setf (gethash 'string memory-report--type-size) + (cadr (assq 'strings elems))) + (setf (gethash 'cons memory-report--type-size) + (cadr (assq 'conses elems))) + (setf (gethash 'symbol memory-report--type-size) + (cadr (assq 'symbols elems))) + (setf (gethash 'object memory-report--type-size) + (cadr (assq 'vectors elems))) + (setf (gethash 'float memory-report--type-size) + (cadr (assq 'floats elems))) + (setf (gethash 'buffer memory-report--type-size) + (cadr (assq 'buffers elems)))) + +(defun memory-report--garbage-collect () + (let ((elems (garbage-collect))) + (memory-report--set-size elems) + (let ((data (list + (list 'strings + (+ (memory-report--gc-elem elems 'strings) + (memory-report--gc-elem elems 'string-bytes))) + (list 'vectors + (+ (memory-report--gc-elem elems 'vectors) + (memory-report--gc-elem elems 'vector-slots))) + (list 'floats (memory-report--gc-elem elems 'floats)) + (list 'conses (memory-report--gc-elem elems 'conses)) + (list 'symbols (memory-report--gc-elem elems 'symbols)) + (list 'intervals (memory-report--gc-elem elems 'intervals)) + (list 'buffer-objects + (memory-report--gc-elem elems 'buffers))))) + (list (cons "Overall Object Memory Usage" + (seq-reduce #'+ (mapcar (lambda (elem) + (* (nth 1 elem) (nth 2 elem))) + elems) + 0)) + (cons "Reserved (But Unused) Object Memory" + (seq-reduce #'+ (mapcar (lambda (elem) + (if (nth 3 elem) + (* (nth 1 elem) (nth 3 elem)) + 0)) + elems) + 0)) + (with-temp-buffer + (insert (propertize "Object Storage\n\n" 'face 'bold)) + (dolist (object (seq-sort (lambda (e1 e2) + (> (cadr e1) (cadr e2))) + data)) + (insert (format "%s %s\n" + (memory-report--format (cadr object)) + (capitalize (symbol-name (car object)))))) + (buffer-string)))))) + +(defun memory-report--largest-variables () + (let ((variables nil)) + (mapatoms + (lambda (symbol) + (when (boundp symbol) + (let ((size (memory-report--object-size + (make-hash-table :test #'eq) + (symbol-value symbol)))) + (when (> size 1000) + (push (cons symbol size) variables))))) + obarray) + (list + (cons (propertize "Memory Used By Global Variables" + 'help-echo "Upper bound; mutually overlapping data from different variables are counted several times") + (seq-reduce #'+ (mapcar #'cdr variables) 0)) + (with-temp-buffer + (insert (propertize "Largest Variables\n\n" 'face 'bold)) + (cl-loop for i from 1 upto 20 + for (symbol . size) in (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + variables) + do (insert (memory-report--format size) + " " + (symbol-name symbol) + "\n")) + (buffer-string))))) + +(defun memory-report--object-size (counted value) + (if (gethash value counted) + 0 + (setf (gethash value counted) t) + (memory-report--object-size-1 counted value))) + +(cl-defgeneric memory-report--object-size-1 (_counted _value) + 0) + +(cl-defmethod memory-report--object-size-1 (_ (value symbol)) + ;; Don't count global symbols -- makes sizes of lists of symbols too + ;; heavey. + (if (intern-soft value obarray) + 0 + (memory-report--size 'symbol))) + +(cl-defmethod memory-report--object-size-1 (_ (_value buffer)) + (memory-report--size 'buffer)) + +(cl-defmethod memory-report--object-size-1 (counted (value string)) + (+ (memory-report--size 'string) + (string-bytes value) + (memory-report--interval-size counted (object-intervals value)))) + +(defun memory-report--interval-size (counted intervals) + ;; We get a list back of intervals, but only count the "inner list" + ;; (i.e., the actual text properties), and add the size of the + ;; intervals themselves. + (+ (* (memory-report--size 'interval) (length intervals)) + (seq-reduce #'+ (mapcar + (lambda (interval) + (memory-report--object-size counted (nth 2 interval))) + intervals) + 0))) + +(cl-defmethod memory-report--object-size-1 (counted (value list)) + (let ((total 0) + (size (memory-report--size 'cons))) + (while value + (cl-incf total size) + (setf (gethash value counted) t) + (when (car value) + (cl-incf total (memory-report--object-size counted (car value)))) + (if (cdr value) + (if (consp (cdr value)) + (setq value (cdr value)) + (cl-incf total (memory-report--object-size counted (cdr value))) + (setq value nil)) + (setq value nil))) + total)) + +(cl-defmethod memory-report--object-size-1 (counted (value vector)) + (let ((total (+ (memory-report--size 'vector) + (* (memory-report--size 'object) (length value))))) + (cl-loop for elem across value + do (setf (gethash elem counted) t) + (cl-incf total (memory-report--object-size counted elem))) + total)) + +(cl-defmethod memory-report--object-size-1 (counted (value hash-table)) + (let ((total (+ (memory-report--size 'vector) + (* (memory-report--size 'object) (hash-table-size value))))) + (maphash + (lambda (key elem) + (setf (gethash key counted) t) + (setf (gethash elem counted) t) + (cl-incf total (memory-report--object-size counted key)) + (cl-incf total (memory-report--object-size counted elem))) + value) + total)) + +(defun memory-report--format (bytes) + (setq bytes (/ bytes 1024.0)) + (let ((units '("kB" "MB" "GB" "TB"))) + (while (>= bytes 1024) + (setq bytes (/ bytes 1024.0)) + (setq units (cdr units))) + (format "%6.1f%s" bytes (car units)))) + +(defun memory-report--gc-elem (elems type) + (* (nth 1 (assq type elems)) + (nth 2 (assq type elems)))) + +(defun memory-report--buffers () + (let ((buffers (mapcar (lambda (buffer) + (cons buffer (memory-report--buffer buffer))) + (buffer-list)))) + (list (cons "Total Buffer Memory Usage" + (seq-reduce #'+ (mapcar #'cdr buffers) 0)) + (with-temp-buffer + (insert (propertize "Largest Buffers\n\n" 'face 'bold)) + (cl-loop for i from 1 upto 20 + for (buffer . size) in (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + buffers) + do (insert (memory-report--format size) + " " + (button-buttonize + (buffer-name buffer) + #'memory-report--buffer-details buffer) + "\n")) + (buffer-string))))) + +(defun memory-report--buffer-details (buffer) + (with-current-buffer buffer + (apply + #'message + "Buffer text: %s; variables: %s; text properties: %s; overlays: %s" + (mapcar #'string-trim (mapcar #'memory-report--format + (memory-report--buffer-data buffer)))))) + +(defun memory-report--buffer (buffer) + (seq-reduce #'+ (memory-report--buffer-data buffer) 0)) + +(defun memory-report--buffer-data (buffer) + (with-current-buffer buffer + (list (save-restriction + (widen) + (+ (position-bytes (point-max)) + (- (position-bytes (point-min))) + (gap-size))) + (seq-reduce #'+ (mapcar (lambda (elem) + (if (cdr elem) + (memory-report--object-size + (make-hash-table :test #'eq) + (cdr elem)) + 0)) + (buffer-local-variables buffer)) + 0) + (memory-report--object-size (make-hash-table :test #'eq) + (object-intervals buffer)) + (memory-report--object-size (make-hash-table :test #'eq) + (overlay-lists))))) + +(defun memory-report--image-cache () + (list (cons "Total Image Cache Size" (if (fboundp 'image-cache-size) + (image-cache-size) + 0)))) + +(provide 'memory-report) + +;;; memory-report.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9c37ce429a7..b7c48dfd3f5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1115,14 +1115,15 @@ boundaries." ;; Use some headers we've invented to drive the process. (let* (;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) + (version-info + (or (lm-header "package-version") (lm-header "version"))) + (pkg-version (package-strip-rcs-id version-info)) (keywords (lm-keywords-list)) (homepage (lm-homepage))) (unless pkg-version - (error - "Package lacks a \"Version\" or \"Package-Version\" header")) + (if version-info + (error "Unrecognized package version: %s" version-info) + (error "Package lacks a \"Version\" or \"Package-Version\" header"))) (package-desc-from-define file-name pkg-version desc (and-let* ((require-lines (lm-header-multiline "package-requires"))) @@ -2112,7 +2113,10 @@ Otherwise return nil." (when str (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) (setq str (substring str (match-end 0)))) - (if (version-to-list str) str))) + (let ((l (version-to-list str))) + ;; Don't return `str' but (package-version-join (version-to-list str)) + ;; to make sure we use a "canonical name"! + (if l (package-version-join l))))) (declare-function lm-homepage "lisp-mnt" (&optional file)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e603900b095..206f0dd1a9d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -409,7 +409,8 @@ of the elements of LIST is performed as if by `pcase-let'. (dolist (case cases) (unless (or (memq case used-cases) (memq (car case) pcase--dontwarn-upats)) - (message "Redundant pcase pattern: %S" (car case)))) + (message "pcase pattern %S shadowed by previous pcase pattern" + (car case)))) (macroexp-let* defs main)))) (defun pcase--macroexpand (pat) diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index c8e483e9a4a..cd42152527e 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -122,7 +122,7 @@ Using `thunk-let' and `thunk-let*' requires `lexical-binding'." (declare (indent 1) (debug let)) (cl-reduce (lambda (expr binding) `(thunk-let (,binding) ,expr)) - (nreverse bindings) + (reverse bindings) :initial-value (macroexp-progn body))) ;; (defalias 'lazy-let #'thunk-let) |