From ed15f3954c04e2039a565ca0d0ff810519da8197 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 4 Jul 2021 16:23:46 +0200 Subject: Ignore .dir-locals-2.el files more * lisp/emacs-lisp/shadow.el (load-path-shadows-find): * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Ignore .dir-locals-2.el, too (bug#23257). --- lisp/emacs-lisp/bytecomp.el | 3 +-- lisp/emacs-lisp/shadow.el | 9 ++++++--- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3e65db42421..70999648d47 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1857,8 +1857,7 @@ also be compiled." (file-readable-p source) (not (string-match "\\`\\.#" file)) (not (auto-save-file-name-p source)) - (not (string-equal dir-locals-file - (file-name-nondirectory source)))) + (not (member source (dir-locals--all-files directory)))) (progn (cl-incf (pcase (byte-recompile-file source force arg) ('no-byte-compile skip-count) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index c1d05941239..02f2ad3d816 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -115,9 +115,12 @@ See the documentation for `list-load-path-shadows' for further information." ;; FILE now contains the current file name, with no suffix. (unless (or (member file files-seen-this-dir) ;; Ignore these files. - (member file (list "subdirs" "leim-list" - (file-name-sans-extension - dir-locals-file)))) + (member file + (list "subdirs" "leim-list" + (file-name-sans-extension dir-locals-file) + (concat + (file-name-sans-extension dir-locals-file) + "-2")))) ;; File has not been seen yet in this directory. ;; This test prevents us declaring that XXX.el shadows ;; XXX.elc (or vice-versa) when they are in the same directory. -- cgit v1.2.3 From 26b9564bd53685533f71e6e102f5bbf575e0c6af Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 5 Jul 2021 15:55:38 +0200 Subject: Propagate :safe properties when autoloading defcustoms * lisp/emacs-lisp/autoload.el (make-autoload): Propagate the :safe property to the loaddefs file (bug#28104). --- etc/NEWS | 3 +++ lisp/emacs-lisp/autoload.el | 5 ++++- 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 1a3130826a5..a62e9c86c93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2914,6 +2914,9 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 +--- +*** :safe settings in 'defcustom' are now propagated to the loaddefs files. + +++ ** New function 'syntax-class-to-char'. This does almost the opposite of 'string-to-syntax' -- it returns the diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index b45984be1d5..9d1ae705976 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -250,7 +250,10 @@ expression, in which case we want to handle forms differently." (custom-autoload ',varname ,file ,(condition-case nil (null (plist-get props :set)) - (error nil)))))) + (error nil))) + ;; Propagate the :safe property to the loaddefs file. + ,@(when-let ((safe (plist-get props :safe))) + `((put ',varname 'safe-local-variable ,safe)))))) ((eq car 'defgroup) ;; In Emacs this is normally handled separately by cus-dep.el, but for -- cgit v1.2.3 From 43fba076c99cb8e62236f636bfc036068a63c166 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 6 Jul 2021 16:43:49 +0200 Subject: Allow inhibiting warnings about unused variables and empty bodies * lisp/emacs-lisp/cconv.el (cconv--warn-unused-msg): Allow inhibiting warnings about unbound variables (bug#26486). * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Allow inhibiting warnings about empty bodies. --- lisp/emacs-lisp/cconv.el | 3 ++- lisp/emacs-lisp/macroexp.el | 18 ++++++++++-------- 2 files changed, 12 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index f6637109028..f1579cda8bd 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -259,7 +259,8 @@ Returns a form where all lambdas don't have any free variables." (not (intern-soft var)) (eq ?_ (aref (symbol-name var) 0)) ;; As a special exception, ignore "ignore". - (eq var 'ignored)) + (eq var 'ignored) + (not (byte-compile-warning-enabled-p 'unbound var))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind var diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index df864464b77..11387df2147 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -319,14 +319,16 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) (macroexp--cons fun - (macroexp--cons (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (format "Empty %s body" fun) - nil t)) - (macroexp--all-forms body)) - (cdr form)) + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (and (byte-compile-warning-enabled-p t) + (format "Empty %s body" fun)) + nil t)) + (macroexp--all-forms body)) + (cdr form)) form)) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. -- cgit v1.2.3 From 044742bfe8c7c22e303242c40e16fbe9e564727a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 6 Jul 2021 01:05:41 +0100 Subject: Avoid invalid regexp in wide docstring check * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Avoid constructing an invalid regexp during byte-compilation by limiting the number of columns to the current RE_DUP_MAX of 65535. This protects against pathological values of fill-column, for example (bug#49426). --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 70999648d47..6970c8a5055 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1627,7 +1627,7 @@ the `\\\\=[command]' ones that are assumed to be of length `byte-compile--wide-docstring-substitution-len'. Also ignore URLs." (string-match - (format "^.\\{%s,\\}$" (int-to-string (1+ col))) + (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX. (replace-regexp-in-string (rx (or ;; Ignore some URLs. -- cgit v1.2.3 From e7cdbc1d1d46b365ec3a7f5eaa0c14f60119014e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 6 Jul 2021 22:01:55 +0200 Subject: Make previous empty-body warning disabling more robust * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): `byte-compile-warning-enabled-p' may not be defined here. --- lisp/emacs-lisp/macroexp.el | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 11387df2147..f4bab9c3456 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -318,18 +318,20 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(,(or 'function 'quote) . ,_) form) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) - (macroexp--cons fun - (macroexp--cons - (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (and (byte-compile-warning-enabled-p t) - (format "Empty %s body" fun)) - nil t)) - (macroexp--all-forms body)) - (cdr form)) - form)) + (macroexp--cons + fun + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (and (or (not (fboundp 'byte-compile-warning-enabled-p)) + (byte-compile-warning-enabled-p t)) + (format "Empty %s body" fun)) + nil t)) + (macroexp--all-forms body)) + (cdr form)) + form)) (`(,(and fun `(lambda . ,_)) . ,args) ;; Embedded lambda in function position. ;; If the byte-optimizer is loaded, try to unfold this, -- cgit v1.2.3 From 57354bc64bdec4cfc70908c80325f665ad7fbc20 Mon Sep 17 00:00:00 2001 From: pillule Date: Thu, 8 Jul 2021 20:39:39 +0300 Subject: Use display-buffer with re-builder (bug#49069) * lisp/emacs-lisp/re-builder.el (re-builder): Uses 'display-buffer' with 'display-buffer-in-direction' to display the reb-buffer. This allow user-customizations and using it on not splitables windows. Add a dedication to its window so killing this buffer quit the window. --- lisp/emacs-lisp/re-builder.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 7d042a9102e..396949d59a2 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -355,11 +355,16 @@ provided in the Commentary section of this library." (reb-delete-overlays)) (setq reb-target-buffer (current-buffer) reb-target-window (selected-window)) - (select-window (or (get-buffer-window reb-buffer) - (progn - (setq reb-window-config (current-window-configuration)) - (split-window (selected-window) (- (window-height) 4))))) - (switch-to-buffer (get-buffer-create reb-buffer)) + (select-window + (or (get-buffer-window reb-buffer) + (let ((dir (if (window-parameter nil 'window-side) + 'bottom 'down))) + (setq reb-window-config (current-window-configuration)) + (display-buffer + (get-buffer-create reb-buffer) + `((display-buffer-in-direction) + (direction . ,dir) + (dedicated . t)))))) (font-lock-mode 1) (reb-initialize-buffer))) -- cgit v1.2.3 From da7dbfdf6858c4644a8d082639edd8a532e47c42 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 10 Jul 2021 18:53:28 +0200 Subject: Make package-menu-filter-by-status work as documented * lisp/emacs-lisp/package.el (package-menu-filter-by-status): Work as documented (bug#49474). --- etc/NEWS | 8 ++++++++ lisp/emacs-lisp/package.el | 11 ++++++++--- 2 files changed, 16 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index da5524a5553..923cfcc4722 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1493,6 +1493,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'. ** Package +--- +*** '/ s' ('package-menu-filter-by-status') changes parameter handling. +The command was documented to take a comma-separated list of statuses +to filter by, but instead it used the parameter as a regexp. The +command has been changed so that it now works as documented, and +checks statuses not as a regexp, but instead an exact match from the +comma-separated list. + +++ *** New command 'package-browse-url' and keystroke 'w'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index a0f1ab0ed67..6bbd4c99763 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3954,9 +3954,14 @@ packages." (package--ensure-package-menu-mode) (if (or (not status) (string-empty-p status)) (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (string-match-p status (package-desc-status pkg-desc))) - (format "status:%s" status)))) + (let ((status-list + (if (listp status) + status + (split-string status ",")))) + (package-menu--filter-by + (lambda (pkg-desc) + (member (package-desc-status pkg-desc) status-list)) + (format "status:%s" (string-join status-list ",")))))) (defun package-menu-filter-by-version (version predicate) "Filter the \"*Packages*\" buffer by VERSION and PREDICATE. -- cgit v1.2.3 From 4aac8f60e688076980d2103d275a78609c03be16 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 15 Jul 2021 10:37:11 +0200 Subject: Mention more split-string-* functions in shortdoc * lisp/emacs-lisp/shortdoc.el (string): Mention split-string-and-unquote and split-string-shell-command. --- lisp/emacs-lisp/shortdoc.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 4df404015a0..1d2c52454be 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -162,6 +162,10 @@ There can be any number of :example/:result elements." :eval (split-string "foo bar") :eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|" t)) + (split-string-and-unquote + :eval (split-string-and-unquote "foo \"bar zot\"")) + (split-string-shell-command + :eval (split-string-shell-command "ls /tmp/'foo bar'")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) -- cgit v1.2.3 From fbc9a509935f87e0627c3dba704108458f2b0389 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 15 Jul 2021 17:36:07 +0200 Subject: Allow restoring the original order in 'tabulated-list-mode' * lisp/emacs-lisp/tabulated-list.el (tabulated-list-sort): Allow restoring the original order (bug#13411). (tabulated-list--sort-by-column-name): Store the original order. (tabulated-list--original-order): New buffer-local variable. --- etc/NEWS | 8 +++++++ lisp/emacs-lisp/tabulated-list.el | 44 ++++++++++++++++++++++++++++++++------- 2 files changed, 44 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 3dfd9f1894c..6e5d358c958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2185,6 +2185,14 @@ summaries will include the failing condition. ** Miscellaneous +--- +*** 'tabulated-list-mode' can now restore original display order. +Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', +and that mode allow the user to sort on any column. There was +previously no easy way to get back to the original displayed order +after sorting, but giving a -1 numerical prefix to the sorting command +will now restore the original order. + +++ *** New utility function 'insert-into-buffer'. This is like 'insert-buffer-substring', but works in the opposite diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0b10dfdc0af..04f3b70aaa8 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -36,6 +36,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup tabulated-list nil "Tabulated-list customization group." :group 'convenience @@ -645,18 +647,41 @@ this is the vector stored within it." (defun tabulated-list-sort (&optional n) "Sort Tabulated List entries by the column at point. -With a numeric prefix argument N, sort the Nth column." +With a numeric prefix argument N, sort the Nth column. + +If the numeric prefix is -1, restore order the list was +originally displayed in." (interactive "P") - (let ((name (if n - (car (aref tabulated-list-format n)) - (get-text-property (point) - 'tabulated-list-column-name)))) - (if (nth 2 (assoc name (append tabulated-list-format nil))) - (tabulated-list--sort-by-column-name name) - (user-error "Cannot sort by %s" name)))) + (if (equal n -1) + ;; Restore original order. + (progn + (unless tabulated-list--original-order + (error "Order is already in original order")) + (setq tabulated-list-entries + (sort tabulated-list-entries + (lambda (e1 e2) + (< (gethash e1 tabulated-list--original-order) + (gethash e2 tabulated-list--original-order))))) + (setq tabulated-list-sort-key nil) + (tabulated-list-init-header) + (tabulated-list-print t)) + ;; Sort based on a column name. + (let ((name (if n + (car (aref tabulated-list-format n)) + (get-text-property (point) + 'tabulated-list-column-name)))) + (if (nth 2 (assoc name (append tabulated-list-format nil))) + (tabulated-list--sort-by-column-name name) + (user-error "Cannot sort by %s" name))))) (defun tabulated-list--sort-by-column-name (name) (when (and name (derived-mode-p 'tabulated-list-mode)) + (unless tabulated-list--original-order + ;; Store the original order so that we can restore it later. + (setq tabulated-list--original-order (make-hash-table)) + (cl-loop for elem in tabulated-list-entries + for i from 0 + do (setf (gethash elem tabulated-list--original-order) i))) ;; Flip the sort order on a second click. (if (equal name (car tabulated-list-sort-key)) (setcdr tabulated-list-sort-key @@ -717,6 +742,8 @@ Interactively, N is the prefix numeric argument, and defaults to ;;; The mode definition: +(defvar tabulated-list--original-order nil) + (define-derived-mode tabulated-list-mode special-mode "Tabulated" "Generic major mode for browsing a list of items. This mode is usually not used directly; instead, other major @@ -757,6 +784,7 @@ as the ewoc pretty-printer." (setq-local glyphless-char-display (tabulated-list-make-glyphless-char-display-table)) (setq-local text-scale-remap-header-line t) + (setq-local tabulated-list--original-order nil) ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. (setq bidi-paragraph-direction 'left-to-right) -- cgit v1.2.3 From 22a5482ab699973e286d7dceb20fe469c94533dd Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 15 Jul 2021 18:29:27 +0200 Subject: Improve the shortdoc link action in *Help* buffers * lisp/emacs-lisp/shortdoc.el (shortdoc-display-group): Allow taking an optional parameter to place point on a specific function. (shortdoc--display-function): Go to the function in question in the shortdoc buffer. --- lisp/emacs-lisp/shortdoc.el | 13 ++++++++----- lisp/help-fns.el | 2 +- 2 files changed, 9 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 1d2c52454be..dbf16967bcf 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1141,8 +1141,9 @@ There can be any number of :example/:result elements." :eval (sqrt -1))) ;;;###autoload -(defun shortdoc-display-group (group) - "Pop to a buffer with short documentation summary for functions in GROUP." +(defun shortdoc-display-group (group &optional function) + "Pop to a buffer with short documentation summary for functions in GROUP. +If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)." (interactive (list (completing-read "Show summary for functions in: " (mapcar #'car shortdoc--groups)))) (when (stringp group) @@ -1173,15 +1174,17 @@ There can be any number of :example/:result elements." (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) - (goto-char (point-min))) + (goto-char (point-min)) + (when function + (text-property-search-forward 'shortdoc-function function t) + (beginning-of-line))) (defun shortdoc--display-function (data) (let ((function (pop data)) (start-section (point)) arglist-start) ;; Function calling convention. - (insert (propertize "(" - 'shortdoc-function t)) + (insert (propertize "(" 'shortdoc-function function)) (if (plist-get data :no-manual) (insert-text-button (symbol-name function) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index afdb0d17b26..d3fdb47a348 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -752,7 +752,7 @@ FILE is the file where FUNCTION was probably defined." (insert-text-button (symbol-name group) 'action (lambda (_) - (shortdoc-display-group group)) + (shortdoc-display-group group object)) 'follow-link t 'help-echo (purecopy "mouse-1, RET: show documentation group"))) groups) -- cgit v1.2.3 From 8f5738eb8fc7556b69016976dfa810f7e6275bf8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 15 Jul 2021 18:32:34 +0200 Subject: Add more car/cdr examples to shortdoc * lisp/emacs-lisp/shortdoc.el (list): Add more car/cdr examples. --- lisp/emacs-lisp/shortdoc.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index dbf16967bcf..3a32f632573 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -503,9 +503,13 @@ There can be any number of :example/:result elements." (flatten-tree :eval (flatten-tree '(1 (2 3) 4))) (car - :eval (car '(one two three))) + :eval (car '(one two three)) + :eval (car '(one . two)) + :eval (car nil)) (cdr - :eval (cdr '(one two three))) + :eval (cdr '(one two three)) + :eval (cdr '(one . two)) + :eval (cdr nil)) (last :eval (last '(one two three))) (butlast -- cgit v1.2.3 From 24a8cc5e707affad345e085b6fe8c778559533f6 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 16 Jul 2021 13:04:14 +0200 Subject: Define revert-buffer-function for *Memory Report* * lisp/emacs-lisp/memory-report.el (memory-report): Allow the memory report buffer to be updated by pressing 'g'. --- lisp/emacs-lisp/memory-report.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index f4f03133b0f..1125dde4055 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -44,6 +44,8 @@ by counted more than once." (pop-to-buffer "*Memory Report*") (special-mode) (button-mode 1) + (setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm) + (memory-report))) (setq truncate-lines t) (message "Gathering data...") (let ((reports (append (memory-report--garbage-collect) -- cgit v1.2.3 From 109c27341e35fae778b95e0eb5d4d72927bf4ea8 Mon Sep 17 00:00:00 2001 From: akater Date: Mon, 12 Jul 2021 14:15:54 +0000 Subject: EIEIO: Prevent excessive evaluation of :initform * lisp/emacs-lisp/eieio.el (initialize-instance): Do not evaluate initform of a slot when initarg for the slot is provided, according to the following secitons of CLHS: - Object Creation and Initialization - Initialization Arguments - Defaulting of Initialization Arguments - Rules for Initialization Arguments * test/lisp/emacs-lisp/eieio-etests/eieio-tests.el: Add corresponding tests Fix a typo --- lisp/emacs-lisp/eieio.el | 35 +++++++++++++++---------- test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 16 ++++++++++- 2 files changed, 36 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1c8c372aaef..b31ea42a99b 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -53,6 +53,7 @@ (message eieio-version)) (require 'eieio-core) +(eval-when-compile (require 'subr-x)) ;;; Defining a new class @@ -740,31 +741,37 @@ Called from the constructor routine." "Construct the new object THIS based on SLOTS.") (cl-defmethod initialize-instance ((this eieio-default-superclass) - &optional slots) + &optional args) "Construct the new object THIS based on SLOTS. -SLOTS is a tagged list where odd numbered elements are tags, and +ARGS is a property list where odd numbered elements are tags, and even numbered elements are the values to store in the tagged slot. If you overload the `initialize-instance', there you will need to call `shared-initialize' yourself, or you can call `call-next-method' to have this constructor called automatically. If these steps are not taken, then new objects of your class will not have their values -dynamically set from SLOTS." - ;; First, see if any of our defaults are `lambda', and - ;; re-evaluate them and apply the value to our slots. +dynamically set from ARGS." (let* ((this-class (eieio--object-class this)) + (initargs args) (slots (eieio--class-slots this-class))) (dotimes (i (length slots)) - ;; For each slot, see if we need to evaluate it. + ;; For each slot, see if we need to evaluate its initform. (let* ((slot (aref slots i)) + (slot-name (eieio-slot-descriptor-name slot)) (initform (cl--slot-descriptor-initform slot))) - ;; Those slots whose initform is constant already have the right - ;; value set in the default-object. - (unless (macroexp-const-p initform) - ;; FIXME: We should be able to just do (aset this (+ i ) dflt)! - (eieio-oset this (cl--slot-descriptor-name slot) - (eval initform t)))))) - ;; Shared initialize will parse our slots for us. - (shared-initialize this slots)) + (unless (or (when-let ((initarg + (car (rassq slot-name + (eieio--class-initarg-tuples + this-class))))) + (plist-get initargs initarg)) + ;; Those slots whose initform is constant already have + ;; the right value set in the default-object. + (macroexp-const-p initform)) + ;; FIXME: Use `aset' instead of `eieio-oset', relying on that + ;; vector returned by `eieio--class-slots' + ;; should be congruent with the object itself. + (eieio-oset this slot-name (eval initform t)))))) + ;; Shared initialize will parse our args for us. + (shared-initialize this args)) (cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 11ffc115f7e..3ec42343443 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -574,7 +574,21 @@ METHOD is the method that was attempting to be called." (setf (get-slot-3 eitest-t1) 'setf-emu) (should (eq (get-slot-3 eitest-t1) 'setf-emu)) ;; Roll back - (setf (get-slot-3 eitest-t1) 'emu)) + (setf (get-slot-3 eitest-t1) 'emu) + (defvar eieio-tests-initform-was-evaluated) + (defclass eieio-tests-initform-not-evaluated-when-initarg-is-present () + ((slot-with-initarg-and-initform + :initarg :slot-with-initarg-and-initform + :initform (setf eieio-tests-initform-was-evaluated t)))) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present) + (should eieio-tests-initform-was-evaluated) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present + :slot-with-initarg-and-initform t) + (should-not eieio-tests-initform-was-evaluated)) (defvar eitest-t2 nil) (ert-deftest eieio-test-26-default-inheritance () -- cgit v1.2.3 From 153c9d5ff4576b74ff9f9589f620c58d590862e8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 17 Jul 2021 15:41:33 +0200 Subject: Make 'n'/'p' work again in shortdoc after previous changes * lisp/emacs-lisp/shortdoc.el (shortdoc--goto-section): Adjust to changes in how the text properties are inserted in 22a5482ab6 (bug#49605). Also make into a regular function. --- lisp/emacs-lisp/shortdoc.el | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 3a32f632573..4beba1dbed1 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1319,16 +1319,15 @@ Example: (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc.") -(defmacro shortdoc--goto-section (arg sym &optional reverse) - `(progn - (unless (natnump ,arg) - (setq ,arg 1)) - (while (< 0 ,arg) - (,(if reverse - 'text-property-search-backward - 'text-property-search-forward) - ,sym t) - (setq ,arg (1- ,arg))))) +(defun shortdoc--goto-section (arg sym &optional reverse) + (unless (natnump arg) + (setq arg 1)) + (while (> arg 0) + (funcall + (if reverse 'text-property-search-backward + 'text-property-search-forward) + sym nil t t) + (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) "Move cursor to the next function. -- cgit v1.2.3