commit e9a668274e441645aed28e8c353187dfed35fcae (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Wed Jan 31 18:56:43 2024 -0500 bytecomp.el: Rewrite the way we print dynamic docstrings We used to print dynamic docstrings "manually" for two reasons: - References should look like `(#$ . POS)` but `prin1` was unable to print just `#$` for an sexp. - `make-docfile` needed to find those docstrings and the object to which they belonged. The second point is moot now that we don't use `make-docfile` on `.elc` files. So this patch lifts the first restriction, using `print-number-table`. The rest of the patch then simplifies and regularises the bytecompiler's generation of dynamic docstrings, which can now also easily be done for "inner" defvars and other places. * src/print.c (print_preprocess, print_object): Handle strings in `print-number-table`. (Vprint_number_table): Improve docstring. * lisp/emacs-lisp/bytecomp.el: (byte-compile--list-with-n): New function. (byte-compile--docstring-style-warn): Rename from `byte-compile-docstring-style-warn` and change calling convention. (byte-compile--\#$, byte-compile--docstrings): New vars. (byte-compile-close-variables): Bind them. (byte-compile--docstring): New function. (byte-compile-from-buffer): Set `byte-compile--\#$`. (byte-compile-output-file-form): Use `byte-compile--\#$` instead of special casing specific forms. (byte-compile--output-docform-recurse, byte-compile-output-docform): Delete functions. (byte-compile-file-form-autoload, byte-compile-file-form-defalias) (byte-compile-file-form-defvar-function, byte-compile-lambda): Use `byte-compile--docstring` and `byte-compile--list-with-n`. (byte-compile--declare-var): Add optional `not-toplevel` arg. (byte-compile-defvar): Add `toplevel` arg. Use `byte-compile--docstring`. (byte-compile-file-form-defvar): Delegate to `byte-compile-defvar`. (byte-compile--custom-declare-face): New function. Use it for `custom-declare-face`. (byte-compile-file-form-defmumble): Use `byte-compile-output-file-form` * src/doc.c (Fdocumentation_stringp): New function. (syms_of_doc): Defsubr it. (store_function_docstring): Remove left-over code from when we used DOC for the docstring of some Lisp files. * lisp/cus-face.el (custom-declare-face): Accept dynamic docstrings. * lisp/faces.el (face-documentation): Handle dynamic docstrings. * lisp/help-fns.el (describe-face): Simplify accordingly. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 0c8b6b0b97c..47afa841f5e 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -32,7 +32,7 @@ (defun custom-declare-face (face spec doc &rest args) "Like `defface', but with FACE evaluated as a normal argument." (when (and doc - (not (stringp doc))) + (not (documentation-stringp doc))) (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) (face-spec-set face (purecopy spec) 'face-defface-spec) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index becc77f504a..6e66771658e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -345,7 +345,7 @@ A value of `all' really means all." '(docstrings-non-ascii-quotes) "List of warning types that are only enabled during Emacs builds. This is typically either warning types that are being phased in -(but shouldn't be enabled for packages yet), or that are only relevant +\(but shouldn't be enabled for packages yet), or that are only relevant for the Emacs build itself.") (defvar byte-compile--suppressed-warnings nil @@ -1740,68 +1740,82 @@ Also ignore URLs." The byte-compiler will emit a warning for documentation strings containing lines wider than this. If `fill-column' has a larger value, it will override this variable." - :group 'bytecomp :type 'natnum :safe #'natnump :version "28.1") -(define-obsolete-function-alias 'byte-compile-docstring-length-warn - 'byte-compile-docstring-style-warn "29.1") - -(defun byte-compile-docstring-style-warn (form) - "Warn if there are stylistic problems with the docstring in FORM. -Warn if documentation string of FORM is too wide. +(defun byte-compile--list-with-n (list n elem) + "Return LIST with its Nth element replaced by ELEM." + (if (eq elem (nth n list)) + list + (nconc (take n list) + (list elem) + (nthcdr (1+ n) list)))) + +(defun byte-compile--docstring-style-warn (docs kind name) + "Warn if there are stylistic problems in the docstring DOCS. +Warn if documentation string is too wide. It is too wide if it has any lines longer than the largest of `fill-column' and `byte-compile-docstring-max-column'." (when (byte-compile-warning-enabled-p 'docstrings) - (let* ((kind nil) (name nil) (docs nil) + (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name)) (prefix (lambda () (format "%s%s" kind - (if name (format-message " `%s' " name) ""))))) - (pcase (car form) - ((or 'autoload 'custom-declare-variable 'defalias - 'defconst 'define-abbrev-table - 'defvar 'defvaralias - 'custom-declare-face) - (setq kind (nth 0 form)) - (setq name (nth 1 form)) - (when (and (consp name) (eq (car name) 'quote)) - (setq name (cadr name))) - (setq docs (nth 3 form))) - ('lambda - (setq kind "") ; can't be "function", unfortunately - (setq docs (nth 2 form)))) - (when (and kind docs (stringp docs)) - (let ((col (max byte-compile-docstring-max-column fill-column))) - (when (and (byte-compile-warning-enabled-p 'docstrings-wide) - (byte-compile--wide-docstring-p docs col)) - (byte-compile-warn-x - name - "%sdocstring wider than %s characters" (funcall prefix) col))) - ;; There's a "naked" ' character before a symbol/list, so it - ;; should probably be quoted with \=. - (when (string-match-p (rx (| (in " \t") bol) - (? (in "\"#")) - "'" - (in "A-Za-z" "(")) + (if name (format-message " `%S' " name) ""))))) + (let ((col (max byte-compile-docstring-max-column fill-column))) + (when (and (byte-compile-warning-enabled-p 'docstrings-wide) + (byte-compile--wide-docstring-p docs col)) + (byte-compile-warn-x + name + "%sdocstring wider than %s characters" (funcall prefix) col))) + ;; There's a "naked" ' character before a symbol/list, so it + ;; should probably be quoted with \=. + (when (string-match-p (rx (| (in " \t") bol) + (? (in "\"#")) + "'" + (in "A-Za-z" "(")) + docs) + (byte-compile-warn-x + name + (concat "%sdocstring has wrong usage of unescaped single quotes" + " (use \\=%c or different quoting such as %c...%c)") + (funcall prefix) ?' ?` ?')) + ;; There's a "Unicode quote" in the string -- it should probably + ;; be an ASCII one instead. + (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) + (when (string-match-p (rx (| " \"" (in " \t") bol) + (in "‘’")) docs) (byte-compile-warn-x name - (concat "%sdocstring has wrong usage of unescaped single quotes" - " (use \\=%c or different quoting such as %c...%c)") - (funcall prefix) ?' ?` ?')) - ;; There's a "Unicode quote" in the string -- it should probably - ;; be an ASCII one instead. - (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) - (when (string-match-p (rx (| " \"" (in " \t") bol) - (in "‘’")) - docs) - (byte-compile-warn-x - name - "%sdocstring uses curved single quotes; use %s instead of ‘...’" - (funcall prefix) "`...'")))))) - form) + "%sdocstring uses curved single quotes; use %s instead of ‘...’" + (funcall prefix) "`...'")))))) + +(defvar byte-compile--\#$) ; Special value that will print as `#$'. +(defvar byte-compile--docstrings nil "Table of already compiled docstrings.") + +(defun byte-compile--docstring (doc kind name &optional is-a-value) + (byte-compile--docstring-style-warn doc kind name) + ;; Make docstrings dynamic, when applicable. + (cond + ((and byte-compile-dynamic-docstrings + ;; The native compiler doesn't use those dynamic docstrings. + (not byte-native-compiling) + ;; Docstrings can only be dynamic when compiling a file. + byte-compile--\#$) + (let* ((byte-pos (with-memoization + ;; Reuse a previously written identical docstring. + ;; This is not done out of thriftiness but to try and + ;; make sure that "equal" functions remain `equal'. + ;; (Often those identical docstrings come from + ;; `help-add-fundoc-usage'). + ;; Needed e.g. for `advice-tests-nadvice'. + (gethash doc byte-compile--docstrings) + (byte-compile-output-as-comment doc nil))) + (newdoc (cons byte-compile--\#$ byte-pos))) + (if is-a-value newdoc (macroexp-quote newdoc)))) + (t doc))) ;; If we have compiled any calls to functions which are not known to be ;; defined, issue a warning enumerating them. @@ -1836,6 +1850,8 @@ It is too wide if it has any lines longer than the largest of ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (byte-compile--\#$ nil) + (byte-compile--docstrings (make-hash-table :test 'equal)) (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) @@ -2363,7 +2379,12 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (when byte-compile-current-file + (when byte-compile-dest-file + (setq byte-compile--\#$ + (copy-sequence ;It needs to be a fresh new object. + ;; Also it stands for the `load-file-name' when the `.elc' will + ;; be loaded, so make it look like it. + byte-compile-dest-file)) (byte-compile-insert-header byte-compile-current-file byte-compile--outbuffer) ;; Instruct native-comp to ignore this file. @@ -2456,11 +2477,7 @@ Call from the source buffer." (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings - ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias, - ;; defconst, autoload, and custom-declare-variable. - ;; defalias calls are output directly by byte-compile-file-form-defmumble; - ;; it does not pay to first build the defalias in defmumble and then parse - ;; it here. + ;; (for `byte-compile-dynamic-docstrings'). (when byte-native-compiling ;; Spill output for the native compiler here (push (make-byte-to-native-top-level :form form :lexical lexical-binding) @@ -2470,123 +2487,17 @@ Call from the source buffer." (print-level nil) (print-quoted t) (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (if (memq (car-safe form) '(defvar defvaralias defconst - autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 - (memq (car form) - '(defvaralias autoload - custom-declare-variable))) - (princ "\n" byte-compile--outbuffer) - (prin1 form byte-compile--outbuffer) - nil))) + (print-circle t) + (print-continuous-numbering t) + (print-number-table (make-hash-table :test #'eq))) + (when byte-compile--\#$ + (puthash byte-compile--\#$ "#$" print-number-table)) + (princ "\n" byte-compile--outbuffer) + (prin1 form byte-compile--outbuffer) + nil)) (defvar byte-compile--for-effect) -(defun byte-compile--output-docform-recurse - (info position form cvecindex docindex quoted) - "Print a form with a doc string. INFO is (prefix postfix). -POSITION is where the next doc string is to be inserted. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that. - -Return the position after any inserted docstrings as comments." - (let ((index 0) - doc-string-position) - ;; Insert the doc string, and make it a comment with #@LENGTH. - (when (and byte-compile-dynamic-docstrings - (stringp (nth docindex form))) - (goto-char position) - (setq doc-string-position - (byte-compile-output-as-comment - (nth docindex form) nil) - position (point)) - (goto-char (point-max))) - - (insert (car info)) - (prin1 (car form) byte-compile--outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((eq index cvecindex) - (let* ((cvec (car form)) - (len (length cvec)) - (index2 0) - elt) - (insert "[") - (while (< index2 len) - (setq elt (aref cvec index2)) - (if (byte-code-function-p elt) - (setq position - (byte-compile--output-docform-recurse - '("#[" "]") position - (append elt nil) ; Convert the vector to a list. - 2 4 nil)) - (prin1 elt byte-compile--outbuffer)) - (setq index2 (1+ index2)) - (unless (eq index2 len) - (insert " "))) - (insert "]"))) - ((= index docindex) - (cond - (doc-string-position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - doc-string-position) - byte-compile--outbuffer)) - ((stringp (car form)) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) - byte-compile--outbuffer))) - (insert "\\\n") - (goto-char (point-max)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (insert (cadr info)) - position)) - -(defun byte-compile-output-docform (preface tailpiece name info form - cvecindex docindex - quoted) - "Print a form with a doc string. INFO is (prefix postfix). -If PREFACE, NAME, and TAILPIECE are non-nil, print them too, -before/after INFO and the FORM but after the doc string itself. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that." - ;; We need to examine byte-compile-dynamic-docstrings - ;; in the input buffer (now current), not in the output buffer. - (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer byte-compile--outbuffer - (let ((byte-compile-dynamic-docstrings dynamic-docstrings) - (position (point)) - (print-continuous-numbering t) - print-number-table - ;; FIXME: The bindings below are only needed for when we're - ;; called from ...-defmumble. - (print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-quoted t) - (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (when preface - ;; FIXME: We don't handle uninterned names correctly. - ;; E.g. if cl-define-compiler-macro uses uninterned name we get: - ;; (defalias '#1=#:foo--cmacro #[514 ...]) - ;; (put 'foo 'compiler-macro '#:foo--cmacro) - (insert preface) - (prin1 name byte-compile--outbuffer)) - (byte-compile--output-docform-recurse - info position form cvecindex docindex quoted) - (when tailpiece - (insert tailpiece)))))) - (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-one-form form t))) @@ -2606,7 +2517,7 @@ list that represents a doc string reference. (if byte-compile-output (let ((form (byte-compile-out-toplevel t 'file))) (cond ((eq (car-safe form) 'progn) - (mapc 'byte-compile-output-file-form (cdr form))) + (mapc #'byte-compile-output-file-form (cdr form))) (form (byte-compile-output-file-form form))) (setq byte-compile-constants nil @@ -2681,12 +2592,12 @@ list that represents a doc string reference. (setq byte-compile-unresolved-functions (delq (assq funsym byte-compile-unresolved-functions) byte-compile-unresolved-functions))))) - (if (stringp (nth 3 form)) - (prog1 - form - (byte-compile-docstring-style-warn form)) - ;; No doc string, so we can compile this as a normal form. - (byte-compile-keep-pending form 'byte-compile-normal-call))) + (let* ((doc (nth 3 form)) + (newdoc (if (not (stringp doc)) doc + (byte-compile--docstring + doc 'autoload (nth 1 form))))) + (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc) + #'byte-compile-normal-call))) (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) @@ -2698,9 +2609,10 @@ list that represents a doc string reference. (byte-compile-warn-x sym "global/dynamic var `%s' lacks a prefix" sym))) -(defun byte-compile--declare-var (sym) +(defun byte-compile--declare-var (sym &optional not-toplevel) (byte-compile--check-prefixed-var sym) - (when (memq sym byte-compile-lexical-variables) + (when (and (not not-toplevel) + (memq sym byte-compile-lexical-variables)) (setq byte-compile-lexical-variables (delq sym byte-compile-lexical-variables)) (when (byte-compile-warning-enabled-p 'lexical sym) @@ -2709,19 +2621,7 @@ list that represents a doc string reference. (push sym byte-compile--seen-defvars)) (defun byte-compile-file-form-defvar (form) - (let ((sym (nth 1 form))) - (byte-compile--declare-var sym) - (if (eq (car form) 'defconst) - (push sym byte-compile-const-variables))) - (if (and (null (cddr form)) ;No `value' provided. - (eq (car form) 'defvar)) ;Just a declaration. - nil - (byte-compile-docstring-style-warn form) - (setq form (copy-sequence form)) - (when (consp (nth 2 form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file))) - form)) + (byte-compile-defvar form 'toplevel)) (put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-defvar-function) @@ -2729,26 +2629,37 @@ list that represents a doc string reference. (defun byte-compile-file-form-defvar-function (form) (pcase-let (((or `',name (let name nil)) (nth 1 form))) - (if name (byte-compile--declare-var name))) - ;; Variable aliases are better declared before the corresponding variable, - ;; since it makes it more likely that only one of the two vars has a value - ;; before the `defvaralias' gets executed, which avoids the need to - ;; merge values. - (pcase form - (`(defvaralias ,_ ',newname . ,_) - (when (memq newname byte-compile-bound-variables) - (if (byte-compile-warning-enabled-p 'suspicious) - (byte-compile-warn-x - newname - "Alias for `%S' should be declared before its referent" newname))))) - (byte-compile-docstring-style-warn form) - (byte-compile-keep-pending form)) + (if name (byte-compile--declare-var name)) + ;; Variable aliases are better declared before the corresponding variable, + ;; since it makes it more likely that only one of the two vars has a value + ;; before the `defvaralias' gets executed, which avoids the need to + ;; merge values. + (pcase form + (`(defvaralias ,_ ',newname . ,_) + (when (memq newname byte-compile-bound-variables) + (if (byte-compile-warning-enabled-p 'suspicious) + (byte-compile-warn-x + newname + "Alias for `%S' should be declared before its referent" + newname))))) + (let ((doc (nth 3 form))) + (when (stringp doc) + (setcar (nthcdr 3 form) + (byte-compile--docstring doc (nth 0 form) name)))) + (byte-compile-keep-pending form))) (put 'custom-declare-variable 'byte-hunk-handler 'byte-compile-file-form-defvar-function) (put 'custom-declare-face 'byte-hunk-handler - 'byte-compile-docstring-style-warn) + #'byte-compile--custom-declare-face) +(defun byte-compile--custom-declare-face (form) + (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form))) + (when (stringp docs) + (let ((newdocs (byte-compile--docstring docs kind name))) + (unless (eq docs newdocs) + (setq form (byte-compile--list-with-n form 3 newdocs))))) + form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -2902,33 +2813,24 @@ not to take responsibility for the actual compilation of the code." (cons (cons bare-name code) (symbol-value this-kind)))) - (if rest - ;; There are additional args to `defalias' (like maybe a docstring) - ;; that the code below can't handle: punt! - nil - ;; Otherwise, we have a bona-fide defun/defmacro definition, and use - ;; special code to allow dynamic docstrings and byte-code. - (byte-compile-flush-pending) + (byte-compile-flush-pending) + (let ((newform `(defalias ',bare-name + ,(if macro `'(macro . ,code) code) ,@rest))) (when byte-native-compiling - ;; Spill output for the native compiler here. + ;; Don't let `byte-compile-output-file-form' push the form to + ;; `byte-to-native-top-level-forms' because we want to use + ;; `make-byte-to-native-func-def' when possible. (push - (if macro + (if (or macro rest) (make-byte-to-native-top-level - :form `(defalias ',name '(macro . ,code) nil) + :form newform :lexical lexical-binding) (make-byte-to-native-func-def :name name :byte-func code)) byte-to-native-top-level-forms)) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" ")" - bare-name - (if macro '(" '(macro . #[" "])") '(" #[" "]")) - (append code nil) ; Turn byte-code-function-p into list. - 2 4 - nil) - t))))) + (let ((byte-native-compiling nil)) + (byte-compile-output-file-form newform))) + t)))) (defun byte-compile-output-as-comment (exp quoted) "Print Lisp object EXP in the output file at point, inside a comment. @@ -3129,9 +3031,9 @@ lambda-expression." (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) (error "Not a lambda list: %S" fun))) - (byte-compile-docstring-style-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) + (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun. (arglistvars (byte-run-strip-symbol-positions (byte-compile-arglist-vars arglist))) (byte-compile-bound-variables @@ -3140,16 +3042,22 @@ lambda-expression." (body (cdr (cdr fun))) (doc (if (stringp (car body)) (prog1 (car body) - ;; Discard the doc string + ;; Discard the doc string from the body ;; unless it is the last element of the body. (if (cdr body) (setq body (cdr body)))))) (int (assq 'interactive body)) command-modes) (when lexical-binding + (when arglist + ;; byte-compile-make-args-desc lost the args's names, + ;; so preserve them in the docstring. + (setq doc (help-add-fundoc-usage doc bare-arglist))) (dolist (var arglistvars) (when (assq var byte-compile--known-dynamic-vars) (byte-compile--warn-lexical-dynamic var 'lambda)))) + (when (stringp doc) + (setq doc (byte-compile--docstring doc "" nil 'is-a-value))) ;; Process the interactive spec. (when int ;; Skip (interactive) if it is in front (the most usual location). @@ -3193,8 +3101,7 @@ lambda-expression." (and lexical-binding (byte-compile-make-lambda-lexenv arglistvars)) - reserved-csts)) - (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. + reserved-csts))) ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) (let ((out @@ -3206,12 +3113,7 @@ lambda-expression." ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. - (cond ((and lexical-binding arglist) - ;; byte-compile-make-args-desc lost the args's names, - ;; so preserve them in the docstring. - (list (help-add-fundoc-usage doc bare-arglist))) - ((or doc int) - (list doc))) + (when (or doc int) (list doc)) ;; optionally, the interactive spec (and the modes the ;; command applies to). (cond @@ -5091,49 +4993,49 @@ binding slots have been popped." (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) (byte-compile-normal-call form)) -(defun byte-compile-defvar (form) - ;; This is not used for file-level defvar/consts. - (when (and (symbolp (nth 1 form)) - (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) - (byte-compile-warning-enabled-p 'lexical (nth 1 form))) - (byte-compile-warn-x - (nth 1 form) - "global/dynamic var `%s' lacks a prefix" - (nth 1 form))) - (byte-compile-docstring-style-warn form) - (let ((fun (nth 0 form)) - (var (nth 1 form)) - (value (nth 2 form)) - (string (nth 3 form))) - (when (or (> (length form) 4) - (and (eq fun 'defconst) (null (cddr form)))) - (let ((ncall (length (cdr form)))) - (byte-compile-warn-x - fun - "`%s' called with %d argument%s, but %s %s" - fun ncall - (if (= 1 ncall) "" "s") - (if (< ncall 2) "requires" "accepts only") - "2-3"))) - (push var byte-compile-bound-variables) +(defun byte-compile-defvar (form &optional toplevel) + (let* ((fun (nth 0 form)) + (var (nth 1 form)) + (value (nth 2 form)) + (string (nth 3 form))) + (byte-compile--declare-var var (not toplevel)) (if (eq fun 'defconst) (push var byte-compile-const-variables)) - (when (and string (not (stringp string))) + (cond + ((stringp string) + (setq string (byte-compile--docstring string fun var 'is-a-value))) + (string (byte-compile-warn-x string "third arg to `%s %s' is not a string: %s" - fun var string)) - ;; Delegate the actual work to the function version of the - ;; special form, named with a "-1" suffix. - (byte-compile-form-do-effect - (cond - ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form))) - ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. - (t `(defvar-1 ',var - ;; Don't eval `value' if `defvar' wouldn't eval it either. - ,(if (macroexp-const-p value) value - `(if (boundp ',var) nil ,value)) - ,@(nthcdr 3 form))))))) + fun var string))) + (if toplevel + ;; At top-level we emit calls to defvar/defconst. + (if (and (null (cddr form)) ;No `value' provided. + (eq (car form) 'defvar)) ;Just a declaration. + nil + (let ((tail (nthcdr 4 form))) + (when (or tail string) (push string tail)) + (when (cddr form) + (push (if (not (consp value)) value + (byte-compile-top-level value nil 'file)) + tail)) + `(,fun ,var ,@tail))) + ;; At non-top-level, since there is no byte code for + ;; defvar/defconst, we delegate the actual work to the function + ;; version of the special form, named with a "-1" suffix. + (byte-compile-form-do-effect + (cond + ((eq fun 'defconst) + `(defconst-1 ',var ,@(byte-compile--list-with-n + (nthcdr 2 form) 1 (macroexp-quote string)))) + ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. + (t `(defvar-1 ',var + ;; Don't eval `value' if `defvar' wouldn't eval it either. + ,(if (macroexp-const-p value) value + `(if (boundp ',var) nil ,value)) + ,@(byte-compile--list-with-n + (nthcdr 3 form) 0 (macroexp-quote string))))))))) (defun byte-compile-autoload (form) (and (macroexp-const-p (nth 1 form)) @@ -5159,14 +5061,6 @@ binding slots have been popped." ;; For the compilation itself, we could largely get rid of this hunk-handler, ;; if it weren't for the fact that we need to figure out when a defalias ;; defines a macro, so as to add it to byte-compile-macro-environment. - ;; - ;; FIXME: we also use this hunk-handler to implement the function's - ;; dynamic docstring feature (via byte-compile-file-form-defmumble). - ;; We should probably actually implement it (more elegantly) in - ;; byte-compile-lambda so it applies to all lambdas. We did it here - ;; so the resulting .elc format was recognizable by make-docfile, - ;; but since then we stopped using DOC for the docstrings of - ;; preloaded elc files so that obstacle is gone. (let ((byte-compile-free-references nil) (byte-compile-free-assignments nil)) (pcase form @@ -5175,7 +5069,11 @@ binding slots have been popped." ;; - `arg' is the expression to which it is defined. ;; - `rest' is the rest of the arguments. (`(,_ ',name ,arg . ,rest) - (byte-compile-docstring-style-warn form) + (let ((doc (car rest))) + (when (stringp doc) + (setq rest (byte-compile--list-with-n + rest 0 + (byte-compile--docstring doc (nth 0 form) name))))) (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). diff --git a/lisp/faces.el b/lisp/faces.el index d5120f42b92..c3a54a08a3d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'." If FACE is a face-alias, get the documentation for the target face." (let ((alias (get face 'face-alias))) (if alias - (let ((doc (get alias 'face-documentation))) + (let ((doc (documentation-property alias 'face-documentation))) (format "%s is an alias for the face `%s'.%s" face alias (if doc (format "\n%s" doc) ""))) - (get face 'face-documentation)))) + (documentation-property face 'face-documentation)))) (defun set-face-documentation (face string) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 99642d08bbd..1ba848c107d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1799,9 +1799,8 @@ If FRAME is omitted or nil, use the selected frame." alias) "")))) (insert "\nDocumentation:\n" - (substitute-command-keys - (or (face-documentation face) - "Not documented as a face.")) + (or (face-documentation face) + "Not documented as a face.") "\n\n")) (with-current-buffer standard-output (save-excursion diff --git a/src/doc.c b/src/doc.c index a451b468ef2..b5a9ed498af 100644 --- a/src/doc.c +++ b/src/doc.c @@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file) return 1; } +DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp, + 1, 1, 0, + doc: /* Return non-nil if OBJECT is a well-formed docstring object. +OBJECT can be either a string or a reference if it's kept externally. */) + (Lisp_Object object) +{ + return (STRINGP (object) + || FIXNUMP (object) /* Reference to DOC. */ + || (CONSP (object) /* Reference to .elc. */ + && STRINGP (XCAR (object)) + && FIXNUMP (XCDR (object))) + ? Qt : Qnil); +} + DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, doc: /* Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the @@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) /* If it's a lisp form, stick it in the form. */ if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); - if (CONSP (fun)) - { - Lisp_Object tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload) - || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) - { - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && FIXNUMP (XCAR (tem))) - /* FIXME: This modifies typically pure hash-cons'd data, so its - correctness is quite delicate. */ - XSETCAR (tem, make_fixnum (offset)); - } - } /* Lisp_Subrs have a slot for it. */ - else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) - { - XSUBR (fun)->doc = offset; - } - - /* Bytecode objects sometimes have slots for it. */ - else if (COMPILEDP (fun)) + if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) + XSUBR (fun)->doc = offset; + else { - /* This bytecode object must have a slot for the - docstring, since we've found a docstring for it. */ - if (PVSIZE (fun) > COMPILED_DOC_STRING - /* Don't overwrite a non-docstring value placed there, - * such as the symbols used for Oclosures. */ - && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING))) - ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); - else - { - AUTO_STRING (format, - (PVSIZE (fun) > COMPILED_DOC_STRING - ? "Docstring slot busy for %s" - : "No docstring slot for %s")); - CALLN (Fmessage, format, - (SYMBOLP (obj) - ? SYMBOL_NAME (obj) - : build_string (""))); - } + AUTO_STRING (format, "Ignoring DOC string on non-subr: %S"); + CALLN (Fmessage, format, obj); } } @@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */); doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); /* Initialized by ‘main’. */ + defsubr (&Sdocumentation_stringp); defsubr (&Sdocumentation); defsubr (&Ssubr_documentation); defsubr (&Sdocumentation_property); diff --git a/src/print.c b/src/print.c index c6a3dba3163..c2beff0ed55 100644 --- a/src/print.c +++ b/src/print.c @@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) { /* OBJ appears more than once. Let's remember that. */ - if (!FIXNUMP (num)) + if (SYMBOLP (num)) /* In practice, nil or t. */ { print_number_index++; /* Negative number indicates it hasn't been printed yet. */ @@ -2265,6 +2265,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; } } + else if (STRINGP (num)) + { + strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun); + goto next_obj; + } } print_depth++; @@ -2554,11 +2559,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; case PVEC_SUB_CHAR_TABLE: { - /* Make each lowest sub_char_table start a new line. - Otherwise we'll make a line extremely long, which - results in slow redisplay. */ - if (XSUB_CHAR_TABLE (obj)->depth == 3) - printchar ('\n', printcharfun); print_c_string ("#^^[", printcharfun); int n = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, @@ -2664,7 +2664,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* With the print-circle feature. */ Lisp_Object num = Fgethash (next, Vprint_number_table, Qnil); - if (FIXNUMP (num)) + if (!(NILP (num) || EQ (num, Qt))) { print_c_string (" . ", printcharfun); obj = next; @@ -2928,7 +2928,10 @@ This variable should not be set with `setq'; bind it with a `let' instead. */); DEFVAR_LISP ("print-number-table", Vprint_number_table, doc: /* A vector used internally to produce `#N=' labels and `#N#' references. The Lisp printer uses this vector to detect Lisp objects referenced more -than once. +than once. If an entry contains a number, then the corresponding key is +referenced more than once: a positive sign indicates that it's already been +printed, and the absolute value indicates the number to use when printing. +If an entry contains a string, that string is printed instead. When you bind `print-continuous-numbering' to t, you should probably also bind `print-number-table' to nil. This ensures that the value of commit e2d1ac2f258a069f950d4df80c8096bfa34081fc Author: Eli Zaretskii Date: Fri Feb 2 18:33:54 2024 +0200 ; * doc/lispref/sequences.texi (Sequence Functions): Fix typo. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 068b69e9ef8..74719d4779f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -461,7 +461,7 @@ each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. This function implements what is known as @dfn{decorate-sort-undecorate} -paradigm, of the Schwartzian transform. It basically trades CPU for +paradigm, or the Schwartzian transform. It basically trades CPU for memory, creating a temporary list with the computed sort keys, then mapping @code{car} over the result of sorting that temporary list. Unlike with @code{sort}, the return value is always a new list; the commit eb9bdb8948683e9870a3e52d085bf0c57d049130 Author: Eli Zaretskii Date: Fri Feb 2 17:48:28 2024 +0200 ; And another fix... diff --git a/lisp/sort.el b/lisp/sort.el index 7047a714661..4f0d759ef8a 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list or vector to sort. +SEQUENCE should be the input sequence to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key commit 02bdb1e4c50153a1754b251538d705d7d81668f8 Author: Eli Zaretskii Date: Fri Feb 2 17:46:19 2024 +0200 ; Another fix of last change. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 9407b5f6342..068b69e9ef8 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -449,13 +449,14 @@ or vector element exactly once. @cindex decorate-sort-undecorate @cindex Schwartzian transform @defun sort-on sequence predicate accessor -This function stably sorts the list or vector @var{sequence}, comparing -the sort keys of the elements using @var{predicate}. The comparison -function @var{predicate} accepts two arguments, the sort keys to -compare, and should return non-@code{nil} if the element corresponding -to the first key should sort before the element corresponding to the -second key. The function computes a sort key of each element by calling -the @var{accessor} function on that element; it does so exactly once for +This function stably sorts @var{sequence}, which can be a list, a +vector, a bool-vector, or a string. It sorts by comparing the sort +keys of the elements using @var{predicate}. The comparison function +@var{predicate} accepts two arguments, the sort keys to compare, and +should return non-@code{nil} if the element corresponding to the first +key should sort before the element corresponding to the second key. The +function computes a sort key of each element by calling the +@var{accessor} function on that element; it does so exactly once for each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. commit f9a15b8a1559999b8dd9895a5f5bb922c4e6730f Author: Eli Zaretskii Date: Fri Feb 2 17:39:23 2024 +0200 ; Fix last change * lisp/sort.el (sort-on): Doc fix. * doc/lispref/sequences.texi (Sequence Functions): Fix description of 'sort-on'. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 896dac35c8e..9407b5f6342 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -436,35 +436,35 @@ but their relative order is also preserved: @end example @end defun -Sometimes, computation of sort keys of list elements is expensive, and -therefore it is important to perform it the minimum number of times. -By contrast, computing the sort keys of elements inside the -@var{predicate} function passed to @code{sort} will generally perform -this computation each time @var{predicate} is called with some +Sometimes, computation of sort keys of list or vector elements is +expensive, and therefore it is important to perform it the minimum +number of times. By contrast, computing the sort keys of elements +inside the @var{predicate} function passed to @code{sort} will generally +perform this computation each time @var{predicate} is called with some element. If you can separate the computation of the sort key of an element into a function of its own, you can use the following sorting function, which guarantees that the key will be computed for each list -element exactly once. +or vector element exactly once. @cindex decorate-sort-undecorate @cindex Schwartzian transform @defun sort-on sequence predicate accessor -This function stably sorts the list @var{sequence}, comparing the sort -keys of the elements using @var{predicate}. The comparison function -@var{predicate} accepts two arguments, the sort keys to compare, and -should return non-@code{nil} if the element corresponding to the first -key should sort before the element corresponding to the second key. -The function computes a sort key of each element by calling the -@var{accessor} function on that element; it does so exactly once for +This function stably sorts the list or vector @var{sequence}, comparing +the sort keys of the elements using @var{predicate}. The comparison +function @var{predicate} accepts two arguments, the sort keys to +compare, and should return non-@code{nil} if the element corresponding +to the first key should sort before the element corresponding to the +second key. The function computes a sort key of each element by calling +the @var{accessor} function on that element; it does so exactly once for each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. -This function implements what is known as -@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. -It basically trades CPU for memory, creating a temporary list with the -computed sport keys, then mapping @code{car} over the result of -sorting that temporary list. Unlike with @code{sort}, the return list -is a copy; the original list is left intact. +This function implements what is known as @dfn{decorate-sort-undecorate} +paradigm, of the Schwartzian transform. It basically trades CPU for +memory, creating a temporary list with the computed sort keys, then +mapping @code{car} over the result of sorting that temporary list. +Unlike with @code{sort}, the return value is always a new list; the +original @var{sequence} is left intact. @end defun @xref{Sorting}, for more functions that perform sorting. See diff --git a/lisp/sort.el b/lisp/sort.el index 97b40a2aef4..7047a714661 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list to sort. +SEQUENCE should be the input list or vector to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key @@ -489,6 +489,7 @@ value to be compared by PREDICATE for sorting the element. PREDICATE is the function for comparing keys; it is called with two arguments, the keys to compare, and should return non-nil if the first key should sort before the second key. +The return value is always a new list. This function has the performance advantage of evaluating ACCESSOR only once for each element in the input SEQUENCE, and is therefore appropriate when computing the key by ACCESSOR is an commit dcce1e07fe750df060ab3a7c6782dc5145710fa3 Author: Eli Zaretskii Date: Fri Feb 2 15:27:25 2024 +0200 ; Fix last change * doc/lispref/sequences.texi (Sequence Functions): Improve indexing of last change diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 654019dfc31..896dac35c8e 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -446,6 +446,8 @@ element into a function of its own, you can use the following sorting function, which guarantees that the key will be computed for each list element exactly once. +@cindex decorate-sort-undecorate +@cindex Schwartzian transform @defun sort-on sequence predicate accessor This function stably sorts the list @var{sequence}, comparing the sort keys of the elements using @var{predicate}. The comparison function commit 4b79c80c999fe95654b7db196b12e0844473f6da Author: Eli Zaretskii Date: Fri Feb 2 15:24:55 2024 +0200 New function 'sort-on' * lisp/sort.el (sort-on): New function. Patch by John Wiegley . * etc/NEWS: * doc/lispref/sequences.texi (Sequence Functions): Document 'sort-on'. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f1f23f007a4..654019dfc31 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -434,12 +434,41 @@ but their relative order is also preserved: (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] @end group @end example - -@xref{Sorting}, for more functions that perform sorting. -See @code{documentation} in @ref{Accessing Documentation}, for a -useful example of @code{sort}. @end defun +Sometimes, computation of sort keys of list elements is expensive, and +therefore it is important to perform it the minimum number of times. +By contrast, computing the sort keys of elements inside the +@var{predicate} function passed to @code{sort} will generally perform +this computation each time @var{predicate} is called with some +element. If you can separate the computation of the sort key of an +element into a function of its own, you can use the following sorting +function, which guarantees that the key will be computed for each list +element exactly once. + +@defun sort-on sequence predicate accessor +This function stably sorts the list @var{sequence}, comparing the sort +keys of the elements using @var{predicate}. The comparison function +@var{predicate} accepts two arguments, the sort keys to compare, and +should return non-@code{nil} if the element corresponding to the first +key should sort before the element corresponding to the second key. +The function computes a sort key of each element by calling the +@var{accessor} function on that element; it does so exactly once for +each element of @var{sequence}. The @var{accessor} function is called +with a single argument, an element of @var{sequence}. + +This function implements what is known as +@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. +It basically trades CPU for memory, creating a temporary list with the +computed sport keys, then mapping @code{car} over the result of +sorting that temporary list. Unlike with @code{sort}, the return list +is a copy; the original list is left intact. +@end defun + +@xref{Sorting}, for more functions that perform sorting. See +@code{documentation} in @ref{Accessing Documentation}, for a useful +example of @code{sort}. + @cindex sequence functions in seq @cindex seq library @cindex sequences, generalized diff --git a/etc/NEWS b/etc/NEWS index 5b3d7dec8a6..816613de4ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1530,6 +1530,11 @@ precedence over the variable when present. Mostly used internally to do a kind of topological sort of inheritance hierarchies. +** New function 'sort-on'. +This function implements the Schwartzian transform, and is appropriate +for sorting lists when the computation of the sort key of a list +element can be expensive. + ** New API for 'derived-mode-p' and control of the graph of major modes. *** 'derived-mode-p' now takes the list of modes as a single argument. diff --git a/lisp/sort.el b/lisp/sort.el index 2ee76b6e1e3..97b40a2aef4 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -478,6 +478,26 @@ sRegexp specifying key within record: \nr") ;; if there was no such register (error (throw 'key nil)))))))))) +;;;###autoload +(defun sort-on (sequence predicate accessor) + "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. +SEQUENCE should be the input list to sort. +Elements of SEQUENCE are sorted by keys which are obtained by +calling ACCESSOR on each element. ACCESSOR should be a function of +one argument, an element of SEQUENCE, and should return the key +value to be compared by PREDICATE for sorting the element. +PREDICATE is the function for comparing keys; it is called with two +arguments, the keys to compare, and should return non-nil if the +first key should sort before the second key. +This function has the performance advantage of evaluating +ACCESSOR only once for each element in the input SEQUENCE, and is +therefore appropriate when computing the key by ACCESSOR is an +expensive operation. This is known as the \"decorate-sort-undecorate\" +paradigm, or the Schwartzian transform." + (mapcar #'car + (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence) + #'(lambda (x y) (funcall predicate (cdr x) (cdr y)))))) + (defvar sort-columns-subprocess t) commit 72b1379f0795a5e2e9c57615c0b1d78c0b97cd1f Author: Stefan Kangas Date: Fri Feb 2 12:28:54 2024 +0100 Increase `emacs-lisp-docstring-fill-column` to 72 Monitors are wider now than when these defaults were first set, and it is useful to take better advantage of that, to fit text on fewer lines. Yet, it has repeatedly been shown that overly long lines reduce readability: "A reasonable guideline would be 55 to 75 characters per line."[1] We also don't want to disfavor narrow displays, like mobile phones; a more promising direction here might be to automatically word wrap docstrings and make their maximum width customizable. That might require a new docstring format, however. Bumping it by 7 characters, from 65 to 72, seems a reasonable compromise for now. Consideration was given to increasing it to 70 or 75, but 72 happens to be a commonly recommended maximum line width elsewhere (see Fortran 66, Python docstrings, commit message recommendations, etc.), and we might as well do the same. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2022-07/msg00217.html [1] "Optimal Line Length in Reading — A Literature Review", Nanavati and Bias, Visible Language, Vol. 39 No. 2 (2005). https://journals.uc.edu/index.php/vl/article/view/5765 * lisp/emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): * .dir-locals.el (fill-column, emacs-lisp-docstring-fill-column): Bump default to 72. diff --git a/.dir-locals.el b/.dir-locals.el index ce7febca851..1f08c882e0b 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -3,8 +3,8 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70) - (emacs-lisp-docstring-fill-column . 65) + (fill-column . 72) + (emacs-lisp-docstring-fill-column . 72) (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) diff --git a/etc/NEWS b/etc/NEWS index 9bd4d0f631b..5b3d7dec8a6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1170,6 +1170,11 @@ Previously, the '@' character, which normally has 'symbol' syntax, would combine with a following Lisp symbol and interfere with symbol searching. +--- +*** 'emacs-lisp-docstring-fill-column' now defaults to 72. +It was previously 65. The new default formats documentation strings to +fit on fewer lines without negatively impacting readability. + ** CPerl mode --- diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ca207ff548d..ad0525e24be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1420,14 +1420,15 @@ A prefix argument specifies pretty-printing." ;;;; Lisp paragraph filling commands. -(defcustom emacs-lisp-docstring-fill-column 65 +(defcustom emacs-lisp-docstring-fill-column 72 "Value of `fill-column' to use when filling a docstring. Any non-integer value means do not use a different value of `fill-column' when filling docstrings." :type '(choice (integer) (const :tag "Use the current `fill-column'" t)) :safe (lambda (x) (or (eq x t) (integerp x))) - :group 'lisp) + :group 'lisp + :version "30.1") (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. commit d89e427852a63dbeed3d5e03d9deb2ae9a8e3e1b Author: Juri Linkov Date: Thu Feb 1 19:16:37 2024 +0200 * lisp/simple.el (read-from-kill-ring): Ignore `read-only' text property. Add `read-only' to the list of text properties removed from history items (bug#68847). diff --git a/lisp/simple.el b/lisp/simple.el index 8246b9cab81..9a33049f4ca 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6419,7 +6419,7 @@ PROMPT is a string to prompt with." 0 (length s) '( keymap local-map action mouse-action - button category help-args) + read-only button category help-args) s) s) kill-ring)) commit 8b92449b706e33da256142e190008bb1ead2e539 Author: Stefan Monnier Date: Thu Feb 1 11:08:56 2024 -0500 * src/lread.c (bytecode_from_rev_list): Fix thinko diff --git a/src/lread.c b/src/lread.c index a6bfdfcf626..cc55b009ab9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3490,7 +3490,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); - if (!(size >= COMPILED_CONSTANTS)) + if (size >= COMPILED_CONSTANTS) { /* Always read 'lazily-loaded' bytecode (generated by the `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to commit 886f4207ab71b2a3367566d013cbcb27eec25639 Author: Stefan Monnier Date: Thu Feb 1 11:06:51 2024 -0500 * src/lread.c (bytecode_from_rev_list): Re-group checks Bring together all the conditions for well-formedness of the resulting bytecode object. diff --git a/src/lread.c b/src/lread.c index e77bfb8021d..a6bfdfcf626 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3490,38 +3490,40 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); + if (!(size >= COMPILED_CONSTANTS)) + { + /* Always read 'lazily-loaded' bytecode (generated by the + `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to + avoid code in the fast path during execution. */ + if (CONSP (vec[COMPILED_BYTECODE]) + && FIXNUMP (XCDR (vec[COMPILED_BYTECODE]))) + vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + if (NILP (vec[COMPILED_CONSTANTS]) && STRINGP (vec[COMPILED_BYTECODE])) + { + Lisp_Object enc = vec[COMPILED_BYTECODE]; + Lisp_Object pair = Fread (Fcons (enc, readcharfun)); + if (!CONSP (pair)) + invalid_syntax ("Invalid byte-code object", readcharfun); + + vec[COMPILED_BYTECODE] = XCAR (pair); + vec[COMPILED_CONSTANTS] = XCDR (pair); + } + } + if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 && (FIXNUMP (vec[COMPILED_ARGLIST]) || CONSP (vec[COMPILED_ARGLIST]) || NILP (vec[COMPILED_ARGLIST])) + && STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS]) && FIXNATP (vec[COMPILED_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - /* Always read 'lazily-loaded' bytecode (generated by the - `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to - avoid code in the fast path during execution. */ - if (CONSP (vec[COMPILED_BYTECODE])) - vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); - - /* Lazily-loaded bytecode is represented by the constant slot being nil - and the bytecode slot a (lazily loaded) string containing the - print representation of (BYTECODE . CONSTANTS). Unpack the - pieces by coerceing the string to unibyte and reading the result. */ - if (NILP (vec[COMPILED_CONSTANTS])) - { - Lisp_Object enc = vec[COMPILED_BYTECODE]; - Lisp_Object pair = Fread (Fcons (enc, readcharfun)); - if (!CONSP (pair)) - invalid_syntax ("Invalid byte-code object", readcharfun); - - vec[COMPILED_BYTECODE] = XCAR (pair); - vec[COMPILED_CONSTANTS] = XCDR (pair); - } - - if (!(STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS]))) - invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) /* BYTESTR must have been produced by Emacs 20.2 or earlier because it produced a raw 8-bit string for byte-code and commit d0766c0999e1e78b2f63e1d97881e926e5e6f905 Author: Thierry Volpiatto Date: Wed Jan 31 13:54:16 2024 +0000 Fix search error in woman.el * lisp/woman.el (woman-if-body): Avoid signaling an error if "el }" is not found. (Bug#68852) diff --git a/lisp/woman.el b/lisp/woman.el index a9af46fa387..2357ba6b132 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2566,7 +2566,8 @@ If DELETE is non-nil then delete from point." ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" ;; Interpret bogus `el \}' as `el \{', ;; especially for Tcl/Tk man pages: - "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*") + "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" + nil t) (match-beginning 1)) (re-search-forward "\\\\}")) (delete-region (if delete from (match-beginning 0)) (point)) commit 4adb4b2ac507636a82373ed1323dabcb7ee9258d Author: Graham Marlow Date: Mon Jan 29 17:16:04 2024 -0800 Fix 'fill-paragraph' in 'yaml-ts-mode' * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode--fill-paragraph): Avoid 'fill-paragraph' when outside of block_scalar or comment nodes. (Bug#68781) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index c0185457bc2..a8cb504ef03 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -128,7 +128,7 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (save-restriction (widen) (let ((node (treesit-node-at (point)))) - (when (string= "block_scalar" (treesit-node-type node)) + (if (member (treesit-node-type node) '("block_scalar" "comment")) (let* ((start (treesit-node-start node)) (end (treesit-node-end node)) (start-marker (point-marker)) @@ -138,7 +138,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (forward-line) (move-marker start-marker (point)) (narrow-to-region (point) end)) - (fill-region start-marker end justify)))))) + (fill-region start-marker end justify)) + t)))) ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" commit ff63da26b6b00fd0e2ba04239b56b385bd83b53a Author: Stanislav Yaglo Date: Mon Jun 12 11:56:37 2023 +0100 macfont.m: Fix values for font widths and weights on macOS * src/macfont.m (mac_font_get_glyphs_for_variants) (macfont_variation_glyphs): Fix width values. (Bug#64013) diff --git a/src/macfont.m b/src/macfont.m index 6f192b00f1b..e3b3d40df43 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -855,21 +855,42 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, struct { enum font_property_index index; CFStringRef trait; - CGPoint points[6]; - CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); - } numeric_traits[] = - {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, - {{-0.4, 50}, /* light */ - {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 80}, /* normal */ - {0.24, 140}, /* (semi-bold + normal) / 2 */ - {0.4, 200}, /* bold */ - {CGFLOAT_MAX, CGFLOAT_MAX}}, - mac_font_descriptor_get_adjusted_weight}, - {FONT_SLANT_INDEX, kCTFontSlantTrait, - {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}, - {FONT_WIDTH_INDEX, kCTFontWidthTrait, - {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}}; + CGPoint points[12]; + CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); + } numeric_traits[] = { + { FONT_WEIGHT_INDEX, + kCTFontWeightTrait, + { { -0.6, 0 }, /* thin */ + { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ + { -0.23, 50 }, /* light */ + { -0.115, 55 }, /* semi-light, semilight, demilight */ + { 0, 80 }, /* regular, normal, unspecified, book */ + { 0.2, 100 }, /* medium */ + { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ + { 0.4, 200 }, /* bold */ + { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ + { 0.8, 210 }, /* black, heavy */ + { 1, 250 }, /* ultra-heavy, ultraheavy */ + { CGFLOAT_MAX, CGFLOAT_MAX } }, + mac_font_descriptor_get_adjusted_weight }, + { FONT_SLANT_INDEX, + kCTFontSlantTrait, + { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } }, + NULL }, + { FONT_WIDTH_INDEX, + kCTFontWidthTrait, + { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ + { -0.3, 63 }, /* extra-condensed, extracondensed */ + { -0.2, 75 }, /* condensed, compressed, narrow */ + { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ + { 0, 100 }, /* normal, medium, regular, unspecified */ + { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ + { 0.2, 125 }, /* expanded */ + { 0.3, 150 }, /* extra-expanded, extraexpanded */ + { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ + { CGFLOAT_MAX, CGFLOAT_MAX } }, + NULL } + }; int i; for (i = 0; i < ARRAYELTS (numeric_traits); i++) @@ -1941,19 +1962,38 @@ static int macfont_variation_glyphs (struct font *, int c, struct { enum font_property_index index; CFStringRef trait; - CGPoint points[6]; - } numeric_traits[] = - {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, - {{-0.4, 50}, /* light */ - {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 100}, /* normal */ - {0.24, 140}, /* (semi-bold + normal) / 2 */ - {0.4, 200}, /* bold */ - {CGFLOAT_MAX, CGFLOAT_MAX}}}, - {FONT_SLANT_INDEX, kCTFontSlantTrait, - {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}, - {FONT_WIDTH_INDEX, kCTFontWidthTrait, - {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}}; + CGPoint points[12]; + } numeric_traits[] = { + { FONT_WEIGHT_INDEX, + kCTFontWeightTrait, + { { -0.6, 0 }, /* thin */ + { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ + { -0.23, 50 }, /* light */ + { -0.115, 55 }, /* semi-light, semilight, demilight */ + { 0, 80 }, /* regular, normal, unspecified, book */ + { 0.2, 100 }, /* medium */ + { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ + { 0.4, 200 }, /* bold */ + { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ + { 0.8, 210 }, /* black, heavy */ + { 1, 250 }, /* ultra-heavy, ultraheavy */ + { CGFLOAT_MAX, CGFLOAT_MAX } } }, + { FONT_SLANT_INDEX, + kCTFontSlantTrait, + { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } } }, + { FONT_WIDTH_INDEX, + kCTFontWidthTrait, + { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ + { -0.3, 63 }, /* extra-condensed, extracondensed */ + { -0.2, 75 }, /* condensed, compressed, narrow */ + { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ + { 0, 100 }, /* normal, medium, regular, unspecified */ + { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ + { 0.2, 125 }, /* expanded */ + { 0.3, 150 }, /* extra-expanded, extraexpanded */ + { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ + { CGFLOAT_MAX, CGFLOAT_MAX } } } + }; registry = AREF (spec, FONT_REGISTRY_INDEX); if (NILP (registry) commit 169c704d74747d411a545eff9c497ddafb9c886c Author: Sacha Chua Date: Fri Jan 26 08:54:03 2024 -0500 shr: Correct SVG attribute case * lisp/net/shr.el (shr-correct-attribute-case): New constant. (shr-correct-dom-case): New function to correct SVG attribute case. (shr-tag-svg): Correct SVG attribute cases before using them. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 17fdffd619d..e23fc6104d2 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1437,13 +1437,85 @@ ones, in case fg and bg are nil." (shr-dom-print elem))))) (insert (format "" (dom-tag dom)))) +(defconst shr-correct-attribute-case + '((attributename . attributeName) + (attributetype . attributeType) + (basefrequency . baseFrequency) + (baseprofile . baseProfile) + (calcmode . calcMode) + (clippathunits . clipPathUnits) + (diffuseconstant . diffuseConstant) + (edgemode . edgeMode) + (filterunits . filterUnits) + (glyphref . glyphRef) + (gradienttransform . gradientTransform) + (gradientunits . gradientUnits) + (kernelmatrix . kernelMatrix) + (kernelunitlength . kernelUnitLength) + (keypoints . keyPoints) + (keysplines . keySplines) + (keytimes . keyTimes) + (lengthadjust . lengthAdjust) + (limitingconeangle . limitingConeAngle) + (markerheight . markerHeight) + (markerunits . markerUnits) + (markerwidth . markerWidth) + (maskcontentunits . maskContentUnits) + (maskunits . maskUnits) + (numoctaves . numOctaves) + (pathlength . pathLength) + (patterncontentunits . patternContentUnits) + (patterntransform . patternTransform) + (patternunits . patternUnits) + (pointsatx . pointsAtX) + (pointsaty . pointsAtY) + (pointsatz . pointsAtZ) + (preservealpha . preserveAlpha) + (preserveaspectratio . preserveAspectRatio) + (primitiveunits . primitiveUnits) + (refx . refX) + (refy . refY) + (repeatcount . repeatCount) + (repeatdur . repeatDur) + (requiredextensions . requiredExtensions) + (requiredfeatures . requiredFeatures) + (specularconstant . specularConstant) + (specularexponent . specularExponent) + (spreadmethod . spreadMethod) + (startoffset . startOffset) + (stddeviation . stdDeviation) + (stitchtiles . stitchTiles) + (surfacescale . surfaceScale) + (systemlanguage . systemLanguage) + (tablevalues . tableValues) + (targetx . targetX) + (targety . targetY) + (textlength . textLength) + (viewbox . viewBox) + (viewtarget . viewTarget) + (xchannelselector . xChannelSelector) + (ychannelselector . yChannelSelector) + (zoomandpan . zoomAndPan)) + "Attributes for correcting the case in SVG and MathML. +Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .") + +(defun shr-correct-dom-case (dom) + "Correct the case for SVG segments." + (dolist (attr (dom-attributes dom)) + (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) + (setcar attr rep))) + (dolist (child (dom-children dom)) + (shr-correct-dom-case child)) + dom) + (defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) (not shr-inhibit-images) (dom-attr dom 'width) (dom-attr dom 'height)) - (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8) - 'image/svg+xml) + (funcall shr-put-image-function + (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8) + 'image/svg+xml) "SVG Image"))) (defun shr-tag-sup (dom) commit 849f8c1d49edc93cd8133d2f0dee5ceeb8f659e5 Author: Po Lu Date: Thu Feb 1 16:25:09 2024 +0800 ; * doc/emacs/basic.texi (Continuation Lines): Rearrange pxref. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index c00cd6e20cf..b1b1573729a 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -636,14 +636,14 @@ long, by using Auto Fill mode. @xref{Filling}. Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. The minor mode @code{visual-wrap-prefix-mode} and its global -counterpart @code{global-visual-wrap-prefix-mode} (@pxref{Minor -Modes}) arranges that continuation lines be prefixed by slightly -adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their -respective logical lines, so that indentation characters or the -prefixes of source code comments are replicated across every -continuation line, and the appearance of such comments or indentation -is not broken. These prefixes are only shown on display, and does not -change the buffer text in any way. +(@pxref{Minor Modes}) counterpart +@code{global-visual-wrap-prefix-mode} arranges that continuation lines +be prefixed by slightly adjusted versions of the fill prefixes +(@pxref{Fill Prefix}) of their respective logical lines, so that +indentation characters or the prefixes of source code comments are +replicated across every continuation line, and the appearance of such +comments or indentation is not broken. These prefixes are only shown +on display, and does not change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding commit 4e1661e96c4412e8bf04cd1ec8948df4a782a10c Author: Po Lu Date: Thu Feb 1 16:18:53 2024 +0800 * src/term.c (produce_glyphs): Synchronize with gui_produce_glyphs. diff --git a/src/term.c b/src/term.c index b3793088fac..3fa244be824 100644 --- a/src/term.c +++ b/src/term.c @@ -1631,8 +1631,19 @@ produce_glyphs (struct it *it) it->pixel_width = it->nglyphs = 0; else if (it->char_to_display == '\t') { + /* wrap-prefix strings are prepended to continuation lines, so + the width of tab characters inside should be computed from + the start of this screen line rather than as a product of the + total width of the physical line being wrapped. */ int absolute_x = (it->current_x - + it->continuation_lines_width); + + (it->string_from_prefix_prop_p + /* Subtract the width of the + prefix from it->current_x if + it exists. */ + ? 0 : (it->continuation_lines_width + ? (it->continuation_lines_width + - it->wrap_prefix_width) + : 0))); int x0 = absolute_x; /* Adjust for line numbers. */ if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) commit 881a1ade30d2efacf9fcbd136b8fea722760f36e Author: Po Lu Date: Thu Feb 1 16:16:09 2024 +0800 Prevent continuation from affecting tab width in/after line prefix * src/dispextern.h (struct it) : New field, synchronized with current_x when producing glyphs for wrap prefixes, and subtracted from it->current_x when computing tab widths. * src/term.c (produce_glyphs): Set wrap_prefix_width. * src/xdisp.c (start_display, display_min_width, move_it_to) (move_it_vertically_backward, move_it_by_lines) (window_text_pixel_size, display_tab_bar_line) (display_tool_bar_line, redisplay_internal, redisplay_window) (try_window_id, insert_left_trunc_glyphs) (extend_face_to_end_of_line, display_line) (Fmove_point_visually): Set or clear wrap_prefix_width as appropriate. (gui_produce_glyphs): Set or clear it->wrap_prefix_width. When computing the base position of a tab character, do not subtract the continuation line width if a line prefix is the current iterator method. Subtract the wrap_prefix_width otherwise, in order that the width of the tab is computed free of influence from the wrap prefix. diff --git a/src/dispextern.h b/src/dispextern.h index 84b9dadc184..5387cb45603 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2752,6 +2752,16 @@ struct it pixel_width with each call to produce_glyphs. */ int current_x; + /* Pixel position within a display line with a wrap prefix. Updated + to reflect current_x in produce_glyphs when producing glyphs from + a prefix string and continuation_lines_width > 0, which is to + say, from a wrap prefix. + + Such updates are unnecessary where it is impossible for a wrap + prefix to be active, e.g. when continuation lines are being + produced. */ + int wrap_prefix_width; + /* Accumulated width of continuation lines. If > 0, this means we are currently in a continuation line. This is initially zero and incremented/reset by display_line, move_it_to etc. */ diff --git a/src/term.c b/src/term.c index 447876d288a..b3793088fac 100644 --- a/src/term.c +++ b/src/term.c @@ -1704,7 +1704,13 @@ produce_glyphs (struct it *it) /* Advance current_x by the pixel width as a convenience for the caller. */ if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } it->ascent = it->max_ascent = it->phys_ascent = it->max_phys_ascent = 0; it->descent = it->max_descent = it->phys_descent = it->max_phys_descent = 1; #endif diff --git a/src/xdisp.c b/src/xdisp.c index 066217a2f0f..4ff689b2df7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3821,7 +3821,7 @@ start_display (struct it *it, struct window *w, struct text_pos pos) it->current_y = first_y; it->vpos = 0; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; } } } @@ -5532,7 +5532,13 @@ display_min_width (struct it *it, ptrdiff_t bufpos, it->object = list3 (Qspace, QCwidth, w); produce_stretch_glyph (it); if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } it->min_width_property = Qnil; } } @@ -10797,6 +10803,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos /* Reset/increment for the next run. */ it->current_x = line_start_x; + it->wrap_prefix_width = 0; line_start_x = 0; it->hpos = 0; it->line_number_produced_p = false; @@ -10827,6 +10834,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos { it->continuation_lines_width += it->current_x; it->current_x = it->hpos = it->max_ascent = it->max_descent = 0; + it->wrap_prefix_width = 0; it->current_y += it->max_ascent + it->max_descent; ++it->vpos; last_height = it->max_ascent + it->max_descent; @@ -10886,6 +10894,7 @@ move_it_vertically_backward (struct it *it, int dy) reseat_1 (it, it->current.pos, true); /* We are now surely at a line start. */ + it->wrap_prefix_width = 0; it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi reordering is in effect. */ it->continuation_lines_width = 0; @@ -11164,7 +11173,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) dvpos--; } - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; /* Above call may have moved too far if continuation lines are involved. Scan forward and see if it did. */ @@ -11173,7 +11182,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) move_it_to (&it2, start_charpos, -1, -1, -1, MOVE_TO_POS); it->vpos -= it2.vpos; it->current_y -= it2.current_y; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; /* If we moved too far back, move IT some lines forward. */ if (it2.vpos > -dvpos) @@ -11452,7 +11461,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, IT.current_x will be incorrectly set to zero at some arbitrary non-zero X coordinate. */ move_it_by_lines (&it, 0); - it.current_x = it.hpos = 0; + it.current_x = it.hpos = it.wrap_prefix_width = 0; if (IT_CHARPOS (it) != start) { void *it1data = NULL; @@ -11505,7 +11514,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, /* If FROM is on a newline, pretend that we start at the beginning of the next line, because the newline takes no place on display. */ if (FETCH_BYTE (start) == '\n') - it.current_x = 0; + it.current_x = 0, it.wrap_prefix_width = 0; if (!NILP (x_limit)) { it.last_visible_x = max_x; @@ -14417,7 +14426,7 @@ display_tab_bar_line (struct it *it, int height) row->truncated_on_left_p = false; row->truncated_on_right_p = false; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; it->current_y += row->height; ++it->vpos; ++it->glyph_row; @@ -15441,7 +15450,7 @@ display_tool_bar_line (struct it *it, int height) row->truncated_on_left_p = false; row->truncated_on_right_p = false; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; it->current_y += row->height; ++it->vpos; ++it->glyph_row; @@ -17141,6 +17150,7 @@ redisplay_internal (void) NULL, DEFAULT_FACE_ID); it.current_x = this_line_start_x; it.current_y = this_line_y; + it.wrap_prefix_width = 0; it.vpos = this_line_vpos; if (current_buffer->long_line_optimizations_p @@ -20587,7 +20597,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) it.current_y = 0; } - it.current_x = it.hpos = 0; + it.current_x = it.wrap_prefix_width = it.hpos = 0; /* Set the window start position here explicitly, to avoid an infinite loop in case the functions in window-scroll-functions @@ -22555,7 +22565,7 @@ try_window_id (struct window *w) /* We may start in a continuation line. If so, we have to get the right continuation_lines_width and current_x. */ it.continuation_lines_width = last_row->continuation_lines_width; - it.hpos = it.current_x = 0; + it.hpos = it.current_x = it.wrap_prefix_width = 0; /* Display the rest of the lines at the window end. */ it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos); @@ -23160,6 +23170,7 @@ insert_left_trunc_glyphs (struct it *it) /* Get the truncation glyphs. */ truncate_it = *it; truncate_it.current_x = 0; + truncate_it.wrap_prefix_width = 0; truncate_it.face_id = DEFAULT_FACE_ID; truncate_it.glyph_row = &scratch_glyph_row; truncate_it.area = TEXT_AREA; @@ -23922,6 +23933,10 @@ extend_face_to_end_of_line (struct it *it) for (it->current_x = 0; g < e; g++) it->current_x += g->pixel_width; + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + it->area = LEFT_MARGIN_AREA; it->face_id = default_face->id; while (it->glyph_row->used[LEFT_MARGIN_AREA] @@ -25064,7 +25079,10 @@ display_line (struct it *it, int cursor_vpos) if (it->current_x < it->first_visible_x && (move_result == MOVE_NEWLINE_OR_CR || move_result == MOVE_POS_MATCH_OR_ZV)) - it->current_x = it->first_visible_x; + { + it->current_x = it->first_visible_x; + it->wrap_prefix_width = 0; + } /* In case move_it_in_display_line_to above "produced" the line number. */ @@ -25921,7 +25939,7 @@ display_line (struct it *it, int cursor_vpos) HPOS) = (0 0). Vertical positions are incremented. As a convenience for the caller, IT->glyph_row is set to the next row to be used. */ - it->current_x = it->hpos = 0; + it->wrap_prefix_width = it->current_x = it->hpos = 0; it->current_y += row->height; /* Restore the first and last visible X if we adjusted them for current-line hscrolling. */ @@ -26400,7 +26418,7 @@ Value is the new character position of point. */) { struct text_pos pt; struct it it; - int pt_x, target_x, pixel_width, pt_vpos; + int pt_x, pt_wrap_prefix_x, target_x, pixel_width, pt_vpos; bool at_eol_p; bool overshoot_expected = false; bool target_is_eol_p = false; @@ -26432,6 +26450,7 @@ Value is the new character position of point. */) reseat: reseat_at_previous_visible_line_start (&it); it.current_x = it.hpos = it.current_y = it.vpos = 0; + it.wrap_prefix_width = 0; if (IT_CHARPOS (it) != PT) { move_it_to (&it, overshoot_expected ? PT - 1 : PT, @@ -26450,6 +26469,7 @@ Value is the new character position of point. */) move_it_in_display_line (&it, PT, -1, MOVE_TO_POS); } pt_x = it.current_x; + pt_wrap_prefix_x = it.wrap_prefix_width; pt_vpos = it.vpos; if (dir > 0 || overshoot_expected) { @@ -26464,10 +26484,11 @@ Value is the new character position of point. */) it.glyph_row = NULL; PRODUCE_GLYPHS (&it); /* compute it.pixel_width */ it.glyph_row = row; - /* PRODUCE_GLYPHS advances it.current_x, so we must restore - it, lest it will become out of sync with it's buffer + /* PRODUCE_GLYPHS advances it.current_x, so it must be + restored, lest it become out of sync with its buffer position. */ it.current_x = pt_x; + it.wrap_prefix_width = pt_wrap_prefix_x; } else at_eol_p = ITERATOR_AT_END_OF_LINE_P (&it); @@ -26512,6 +26533,7 @@ Value is the new character position of point. */) it.last_visible_x = DISP_INFINITY; reseat_at_previous_visible_line_start (&it); it.current_x = it.current_y = it.hpos = 0; + it.wrap_prefix_width = 0; if (pt_vpos != 0) move_it_by_lines (&it, pt_vpos); } @@ -32659,7 +32681,19 @@ gui_produce_glyphs (struct it *it) if (font->space_width > 0) { int tab_width = it->tab_width * font->space_width; - int x = it->current_x + it->continuation_lines_width; + /* wrap-prefix strings are prepended to continuation + lines, so the width of tab characters inside should + be computed from the start of this screen line rather + than as a product of the total width of the physical + line being wrapped. */ + int x = it->current_x + (it->string_from_prefix_prop_p + /* Subtract the width of the + prefix from it->current_x if + it exists. */ + ? 0 : (it->continuation_lines_width + ? (it->continuation_lines_width + - it->wrap_prefix_width) + : 0)); int x0 = x; /* Adjust for line numbers, if needed. */ if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) @@ -33130,7 +33164,13 @@ gui_produce_glyphs (struct it *it) because this isn't true for images with `:ascent 100'. */ eassert (it->ascent >= 0 && it->descent >= 0); if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } if (extra_line_spacing > 0) { commit b86bc02096c65517b9a29c20635ece100864fc62 Author: Po Lu Date: Thu Feb 1 16:08:47 2024 +0800 Introduce a global variant of visual-wrap-prefix-mode * doc/emacs/basic.texi (Continuation Lines): * etc/NEWS: * lisp/visual-wrap.el (visual-wrap-prefix-mode): Document this new global minor mode. (global-visual-wrap-prefix-mode): New global minor mode. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cdc183c2a40..c00cd6e20cf 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -632,15 +632,18 @@ long, by using Auto Fill mode. @xref{Filling}. @cindex continuation lines, visual wrap prefix @findex visual-wrap-prefix-mode +@findex global-visual-wrap-prefix-mode Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. -The minor mode @code{visual-wrap-prefix-mode} arranges that -continuation lines be prefixed by slightly adjusted versions of the -fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, -so that indentation characters or the prefixes of source code comments -are replicated across every continuation line, and the appearance of -such comments or indentation is not broken. These prefixes are only -shown on display, and does not change the buffer text in any way. +The minor mode @code{visual-wrap-prefix-mode} and its global +counterpart @code{global-visual-wrap-prefix-mode} (@pxref{Minor +Modes}) arranges that continuation lines be prefixed by slightly +adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their +respective logical lines, so that indentation characters or the +prefixes of source code comments are replicated across every +continuation line, and the appearance of such comments or indentation +is not broken. These prefixes are only shown on display, and does not +change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding diff --git a/etc/NEWS b/etc/NEWS index 8fccc299c6b..9bd4d0f631b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -318,7 +318,9 @@ will receive a 'wrap-prefix' automatically computed from the line's surrounding context, such that continuation lines are indented on display as if they were filled with 'M-q' or similar. Unlike 'M-q', the indentation only happens on display, and doesn't change the buffer -text in any way. +text in any way. The global minor mode +'global-visual-wrap-prefix-mode' enables this minor mode in all +buffers. (This minor mode is the 'adaptive-wrap' ELPA package renamed and lightly edited for inclusion in Emacs.) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 20e55444082..d95cf4bb569 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -173,7 +173,9 @@ by `visual-wrap-extra-indent'." ;;;###autoload (define-minor-mode visual-wrap-prefix-mode - "Display continuation lines with prefixes from surrounding context." + "Display continuation lines with prefixes from surrounding context. +To enable this minor mode across all buffers, enable +`global-visual-wrap-prefix-mode'." :lighter "" :group 'visual-line (if visual-wrap-prefix-mode @@ -192,5 +194,11 @@ by `visual-wrap-extra-indent'." (widen) (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) +;;;###autoload +(define-globalized-minor-mode global-visual-wrap-prefix-mode + visual-wrap-prefix-mode visual-wrap-prefix-mode + :init-value nil + :group 'visual-line) + (provide 'visual-wrap) ;;; visual-wrap.el ends here commit cd2c45a3890601e1bc498c81e64791fead6efc86 Author: Mattias Engdegård Date: Wed Jan 31 17:50:30 2024 +0100 ; hierarchy-tests.el: keep doc string within 80 columns diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 49c812edb05..3333f4014e6 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -570,8 +570,9 @@ should fail as this function will crash." (defun hierarchy-examples-delayed--childrenfn (hier-elem) "Return the children of HIER-ELEM. -Basically, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' -and then create a list of the number plus 0.0–0.9." +Basically, feed the number, minus 1, to +`hierarchy-examples-delayed--find-number' and then create a list of the +number plus 0.0–0.9." (when (> hier-elem 1) (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem)))) commit 344a846b07dfcc9ad38e510da9115fadae94a477 Author: Mattias Engdegård Date: Wed Jan 31 17:35:59 2024 +0100 Bytecode engine fast-path streamlining of plain symbols * src/bytecode.c (exec_byte_code): Only use fast-path optimisations for calls and dynamic variable reference and setting where the symbol is plain, which is much faster. diff --git a/src/bytecode.c b/src/bytecode.c index def20b232c6..dd805cbd97a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -625,9 +625,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, varref: { Lisp_Object v1 = vectorp[op], v2; - if (!SYMBOLP (v1) - || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL - || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) + if (!BARE_SYMBOL_P (v1) + || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL + || (v2 = XBARE_SYMBOL (v1)->u.s.val.value, + BASE_EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); NEXT; @@ -699,11 +700,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object val = POP; /* Inline the most common case. */ - if (SYMBOLP (sym) + if (BARE_SYMBOL_P (sym) && !BASE_EQ (val, Qunbound) - && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL - && !SYMBOL_TRAPPED_WRITE_P (sym)) - SET_SYMBOL_VAL (XSYMBOL (sym), val); + && XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL + && !XBARE_SYMBOL (sym)->u.s.trapped_write) + SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val); else set_internal (sym, val, Qnil, SET_INTERNAL_SET); } @@ -790,8 +791,9 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, do_debug_on_call (Qlambda, count1); Lisp_Object original_fun = call_fun; - if (SYMBOLP (call_fun)) - call_fun = XSYMBOL (call_fun)->u.s.function; + /* Calls to symbols-with-pos don't need to be on the fast path. */ + if (BARE_SYMBOL_P (call_fun)) + call_fun = XBARE_SYMBOL (call_fun)->u.s.function; if (COMPILEDP (call_fun)) { Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); commit 9bcc9690a8076a22398c27a7ccf836ee95eb16a2 Author: Mattias Engdegård Date: Tue Jan 30 17:55:19 2024 +0100 Eliminate lazy bytecode loading The obsolete lazy-loaded bytecode feature, enabled by `byte-compile-dynamic`, slows down Lisp execution even when not in use because every call to a bytecode function has to check that function for laziness. This change forces up-front loading of all lazy bytecode so that we can remove all those checks. (Dynamically loaded doc strings are not affected.) There is no point in generating lazy bytecode any more so we stop doing that; this simplifies the compiler. `byte-compile-dynamic` now has no effect. This is a fully compatible change; the few remaining users of `byte-compile-dynamic` should not notice any difference. * src/lread.c (bytecode_from_rev_list): Force eager loading of lazy bytecode. * src/bytecode.c (exec_byte_code): Remove lazy bytecode checks. * src/eval.c (fetch_and_exec_byte_code, Ffetch_bytecode): Remove. (funcall_lambda): Call exec_byte_code directly, avoiding checks. * lisp/subr.el (fetch-bytecode): New definition, obsolete no-op. * lisp/emacs-lisp/disass.el (disassemble-1): * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Remove calls to fetch-bytecode. (byte-compile-dynamic): Update doc string. (byte-compile-close-variables, byte-compile-from-buffer) (byte-compile-insert-header, byte-compile-output-file-form) (byte-compile--output-docform-recurse, byte-compile-output-docform) (byte-compile-file-form-defmumble): Remove effects of byte-compile-dynamic. * doc/lispref/compile.texi (Dynamic Loading): Remove node now that the entire `byte-compile-dynamic` facility has been rendered inert. * etc/NEWS: Announce changes. diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 98a01fb67f9..00602198da5 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -35,7 +35,6 @@ variable binding for @code{no-byte-compile} into it, like this: * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. @@ -289,71 +288,6 @@ stands for the name of this file, as a string. Do not use these constructs in Lisp source files; they are not designed to be clear to humans reading the file. -@node Dynamic Loading -@section Dynamic Loading of Individual Functions - -@cindex dynamic loading of functions -@cindex lazy loading - When you compile a file, you can optionally enable the @dfn{dynamic -function loading} feature (also known as @dfn{lazy loading}). With -dynamic function loading, loading the file doesn't fully read the -function definitions in the file. Instead, each function definition -contains a place-holder which refers to the file. The first time each -function is called, it reads the full definition from the file, to -replace the place-holder. - - The advantage of dynamic function loading is that loading the file -should become faster. This is a good thing for a file which contains -many separate user-callable functions, if using one of them does not -imply you will probably also use the rest. A specialized mode which -provides many keyboard commands often has that usage pattern: a user may -invoke the mode, but use only a few of the commands it provides. - - The dynamic loading feature has certain disadvantages: - -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer load the remaining function definitions not already loaded. - -@item -If you alter the compiled file (such as by compiling a new version), -then trying to load any function not already loaded will usually yield -nonsense results. -@end itemize - - These problems will never happen in normal circumstances with -installed Emacs files. But they are quite likely to happen with Lisp -files that you are changing. The easiest way to prevent these problems -is to reload the new compiled file immediately after each recompilation. - - @emph{Experience shows that using dynamic function loading provides -benefits that are hardly measurable, so this feature is deprecated -since Emacs 27.1.} - - The byte compiler uses the dynamic function loading feature if the -variable @code{byte-compile-dynamic} is non-@code{nil} at compilation -time. Do not set this variable globally, since dynamic loading is -desirable only for certain files. Instead, enable the feature for -specific source files with file-local variable bindings. For example, -you could do it by writing this text in the source file's first line: - -@example --*-byte-compile-dynamic: t;-*- -@end example - -@defvar byte-compile-dynamic -If this is non-@code{nil}, the byte compiler generates compiled files -that are set up for dynamic function loading. -@end defvar - -@defun fetch-bytecode function -If @var{function} is a byte-code function object, this immediately -finishes loading the byte code of @var{function} from its -byte-compiled file, if it is not fully loaded already. Otherwise, -it does nothing. It always returns @var{function}. -@end defun - @node Eval During Compile @section Evaluation During Compilation @cindex eval during compilation diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a3ef8313f8e..cab1622337e 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -653,7 +653,6 @@ Byte Compilation * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. diff --git a/etc/NEWS b/etc/NEWS index a9d6eb6789d..8fccc299c6b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1846,6 +1846,13 @@ The declaration '(important-return-value t)' sets the 'important-return-value' property which indicates that the function return value should probably not be thrown away implicitly. +** Bytecode is now always loaded eagerly. +Bytecode compiled with older Emacs versions for lazy loading using +'byte-compile-dynamic' is now loaded all at once. +As a consequence, 'fetch-bytecode' has no use, does nothing, and is +now obsolete. The variable 'byte-compile-dynamic' has no effect any +more; compilation will always yield bytecode for eager loading. + +++ ** New functions 'file-user-uid' and 'file-group-gid'. These functions are like 'user-uid' and 'group-gid', respectively, but diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e87595b3e77..becc77f504a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -231,17 +231,8 @@ This includes variable references and calls to functions such as `car'." :type 'boolean) (defvar byte-compile-dynamic nil - "If non-nil, compile function bodies so they load lazily. -They are hidden in comments in the compiled file, -and each one is brought into core when the -function is called. - -To enable this option, make it a file-local variable -in the source file you want it to apply to. -For example, add -*-byte-compile-dynamic: t;-*- on the first line. - -When this option is true, if you load the compiled file and then move it, -the functions you loaded will not be able to run.") + "Formerly used to compile function bodies so they load lazily. +This variable no longer has any effect.") (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) @@ -1858,7 +1849,6 @@ It is too wide if it has any lines longer than the largest of ;; (byte-compile-verbose byte-compile-verbose) (byte-optimize byte-optimize) - (byte-compile-dynamic byte-compile-dynamic) (byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings) (byte-compile-warnings byte-compile-warnings) @@ -2428,8 +2418,7 @@ With argument ARG, insert value in current buffer after the form." (defun byte-compile-insert-header (_filename outbuffer) "Insert a header at the start of OUTBUFFER. Call from the source buffer." - (let ((dynamic byte-compile-dynamic) - (optimize byte-optimize)) + (let ((optimize byte-optimize)) (with-current-buffer outbuffer (goto-char (point-min)) ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After @@ -2463,10 +2452,7 @@ Call from the source buffer." ((eq optimize 'byte) " byte-level optimization only") (optimize " all optimizations") (t "out optimization")) - ".\n" - (if dynamic ";;; Function definitions are lazy-loaded.\n" - "") - "\n\n")))) + ".\n\n\n")))) (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings @@ -2487,7 +2473,7 @@ Call from the source buffer." (print-circle t)) ; Handle circular data structures. (if (memq (car-safe form) '(defvar defvaralias defconst autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil + (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 (memq (car form) '(defvaralias autoload custom-declare-variable))) @@ -2498,15 +2484,11 @@ Call from the source buffer." (defvar byte-compile--for-effect) (defun byte-compile--output-docform-recurse - (info position form cvecindex docindex specindex quoted) + (info position form cvecindex docindex quoted) "Print a form with a doc string. INFO is (prefix postfix). POSITION is where the next doc string is to be inserted. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that. @@ -2529,29 +2511,7 @@ Return the position after any inserted docstrings as comments." (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (when (hash-table-p print-number-table) - (maphash (lambda (_k v) (if v (setq non-nil t))) - print-number-table)) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (goto-char position) - (let ((lazy-position (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (setq position (point)) - (goto-char (point-max)) - (princ (format "(#$ . %d) nil" lazy-position) - byte-compile--outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((eq index cvecindex) + (cond ((eq index cvecindex) (let* ((cvec (car form)) (len (length cvec)) (index2 0) @@ -2564,7 +2524,7 @@ Return the position after any inserted docstrings as comments." (byte-compile--output-docform-recurse '("#[" "]") position (append elt nil) ; Convert the vector to a list. - 2 4 specindex nil)) + 2 4 nil)) (prin1 elt byte-compile--outbuffer)) (setq index2 (1+ index2)) (unless (eq index2 len) @@ -2590,16 +2550,12 @@ Return the position after any inserted docstrings as comments." (defun byte-compile-output-docform (preface tailpiece name info form cvecindex docindex - specindex quoted) + quoted) "Print a form with a doc string. INFO is (prefix postfix). If PREFACE, NAME, and TAILPIECE are non-nil, print them too, before/after INFO and the FORM but after the doc string itself. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that." @@ -2627,7 +2583,7 @@ list that represents a doc string reference. (insert preface) (prin1 name byte-compile--outbuffer)) (byte-compile--output-docform-recurse - info position form cvecindex docindex specindex quoted) + info position form cvecindex docindex quoted) (when tailpiece (insert tailpiece)))))) @@ -2971,7 +2927,6 @@ not to take responsibility for the actual compilation of the code." (if macro '(" '(macro . #[" "])") '(" #[" "]")) (append code nil) ; Turn byte-code-function-p into list. 2 4 - (and (atom code) byte-compile-dynamic 1) nil) t))))) @@ -3810,7 +3765,6 @@ lambda-expression." (alen (length (cdr form))) (dynbinds ()) lap) - (fetch-bytecode fun) (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) ;; optimized switch bytecode makes it impossible to guess the correct ;; `byte-compile-depth', which can result in incorrect inlined code. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index a876e6b5744..b7db2adde59 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (if (consp obj) (setq bytes (car (cdr obj)) ;the byte code constvec (car (cdr (cdr obj)))) ;constant vector - ;; If it is lazy-loaded, load it now - (fetch-bytecode obj) (setq bytes (aref obj 1) constvec (aref obj 2))) (cl-assert (not (multibyte-string-p bytes))) diff --git a/lisp/subr.el b/lisp/subr.el index 33de100870e..a97824965b5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2023,6 +2023,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation) +(define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/bytecode.c b/src/bytecode.c index ed6e2b34e77..def20b232c6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -792,22 +792,19 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object original_fun = call_fun; if (SYMBOLP (call_fun)) call_fun = XSYMBOL (call_fun)->u.s.function; - Lisp_Object template; - Lisp_Object bytecode; - if (COMPILEDP (call_fun) - /* Lexical binding only. */ - && (template = AREF (call_fun, COMPILED_ARGLIST), - FIXNUMP (template)) - /* No autoloads. */ - && (bytecode = AREF (call_fun, COMPILED_BYTECODE), - !CONSP (bytecode))) + if (COMPILEDP (call_fun)) { - fun = call_fun; - bytestr = bytecode; - args_template = XFIXNUM (template); - nargs = call_nargs; - args = call_args; - goto setup_frame; + Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); + if (FIXNUMP (template)) + { + /* Fast path for lexbound functions. */ + fun = call_fun; + bytestr = AREF (call_fun, COMPILED_BYTECODE), + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } } Lisp_Object val; diff --git a/src/eval.c b/src/eval.c index 6f1c39ffb0e..95eb21909d2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3122,19 +3122,6 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } -/* Call the compiled Lisp function FUN. If we have not yet read FUN's - bytecode string and constants vector, fetch them from the file first. */ - -static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, - ptrdiff_t nargs, Lisp_Object *args) -{ - if (CONSP (AREF (fun, COMPILED_BYTECODE))) - Ffetch_bytecode (fun); - - return exec_byte_code (fun, args_template, nargs, args); -} - static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { @@ -3204,8 +3191,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, ARGLIST slot value: pass the arguments to the byte-code engine directly. */ if (FIXNUMP (syms_left)) - return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), - nargs, arg_vector); + return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); /* Otherwise the bytecode object uses dynamic binding and the ARGLIST slot contains a standard formal argument list whose variables are bound dynamically below. */ @@ -3293,7 +3279,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, 0, 0, NULL); + val = exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3411,46 +3397,6 @@ lambda_arity (Lisp_Object fun) return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); } -DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, - 1, 1, 0, - doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */) - (Lisp_Object object) -{ - Lisp_Object tem; - - if (COMPILEDP (object)) - { - if (CONSP (AREF (object, COMPILED_BYTECODE))) - { - tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); - if (! (CONSP (tem) && STRINGP (XCAR (tem)) - && VECTORP (XCDR (tem)))) - { - tem = AREF (object, COMPILED_BYTECODE); - if (CONSP (tem) && STRINGP (XCAR (tem))) - error ("Invalid byte code in %s", SDATA (XCAR (tem))); - else - error ("Invalid byte code"); - } - - Lisp_Object bytecode = XCAR (tem); - if (STRING_MULTIBYTE (bytecode)) - { - /* BYTECODE must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and now - such a byte-code string is loaded as multibyte with raw 8-bit - characters converted to multibyte form. Convert them back to - the original unibyte form. */ - bytecode = Fstring_as_unibyte (bytecode); - } - - pin_string (bytecode); - ASET (object, COMPILED_BYTECODE, bytecode); - ASET (object, COMPILED_CONSTANTS, XCDR (tem)); - } - } - return object; -} /* Return true if SYMBOL's default currently has a let-binding which was made in the buffer that is now current. */ @@ -4512,7 +4458,6 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Srun_hook_wrapped); - defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); DEFSYM (QCdebug_on_exit, ":debug-on-exit"); defsubr (&Smapbacktrace); diff --git a/src/lread.c b/src/lread.c index 929f86ef283..e77bfb8021d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3481,6 +3481,8 @@ vector_from_rev_list (Lisp_Object elems) return obj; } +static Lisp_Object get_lazy_string (Lisp_Object val); + static Lisp_Object bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) { @@ -3495,14 +3497,18 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) && FIXNATP (vec[COMPILED_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (load_force_doc_strings - && NILP (vec[COMPILED_CONSTANTS]) - && STRINGP (vec[COMPILED_BYTECODE])) + /* Always read 'lazily-loaded' bytecode (generated by the + `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to + avoid code in the fast path during execution. */ + if (CONSP (vec[COMPILED_BYTECODE])) + vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + if (NILP (vec[COMPILED_CONSTANTS])) { - /* Lazily-loaded bytecode is represented by the constant slot being nil - and the bytecode slot a (lazily loaded) string containing the - print representation of (BYTECODE . CONSTANTS). Unpack the - pieces by coerceing the string to unibyte and reading the result. */ Lisp_Object enc = vec[COMPILED_BYTECODE]; Lisp_Object pair = Fread (Fcons (enc, readcharfun)); if (!CONSP (pair)) @@ -3512,25 +3518,20 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) vec[COMPILED_CONSTANTS] = XCDR (pair); } - if (!((STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS])) - || CONSP (vec[COMPILED_BYTECODE]))) + if (!(STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRINGP (vec[COMPILED_BYTECODE])) - { - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) - { - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); - } - /* Bytecode must be immovable. */ - pin_string (vec[COMPILED_BYTECODE]); - } + if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); + + /* Bytecode must be immovable. */ + pin_string (vec[COMPILED_BYTECODE]); XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); return obj; commit 7e85311a9113a4720ec9d7b06188646fc7bdae0b Author: Mattias Engdegård Date: Wed Jan 31 12:21:12 2024 +0100 Allow equal user-defined hash table tests with different names Hash tables using different user-defined tests defined identically sometimes ended up using the wrong test (bug#68668). * src/fns.c (get_hash_table_user_test): Take test name into account when matching the test object. * test/src/fns-tests.el (fns--define-hash-table-test): New. diff --git a/src/fns.c b/src/fns.c index e4fa8157000..1262e3e749e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5374,6 +5374,8 @@ mark_fns (void) } } +/* Find the hash_table_test object correponding to the (bare) symbol TEST, + creating one if none existed. */ static struct hash_table_test * get_hash_table_user_test (Lisp_Object test) { @@ -5384,7 +5386,8 @@ get_hash_table_user_test (Lisp_Object test) Lisp_Object equal_fn = XCAR (prop); Lisp_Object hash_fn = XCAR (XCDR (prop)); struct hash_table_user_test *ut = hash_table_user_tests; - while (ut && !(EQ (equal_fn, ut->test.user_cmp_function) + while (ut && !(BASE_EQ (test, ut->test.name) + && EQ (equal_fn, ut->test.user_cmp_function) && EQ (hash_fn, ut->test.user_hash_function))) ut = ut->next; if (!ut) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3893b8b0320..7437c07f156 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1097,6 +1097,16 @@ (should (= (sxhash-equal (record 'a (make-string 10 ?a))) (sxhash-equal (record 'a (make-string 10 ?a)))))) +(ert-deftest fns--define-hash-table-test () + ;; Check that we can have two differently-named tests using the + ;; same functions (bug#68668). + (define-hash-table-test 'fns-tests--1 'my-cmp 'my-hash) + (define-hash-table-test 'fns-tests--2 'my-cmp 'my-hash) + (let ((h1 (make-hash-table :test 'fns-tests--1)) + (h2 (make-hash-table :test 'fns-tests--2))) + (should (eq (hash-table-test h1) 'fns-tests--1)) + (should (eq (hash-table-test h2) 'fns-tests--2)))) + (ert-deftest test-secure-hash () (should (equal (secure-hash 'md5 "foobar") "3858f62230ac3c915f300c664312c63f"))